diff --git a/config/gfortran_avx.cfg b/config/gfortran_avx.cfg index 80bbbec9..f065d133 100644 --- a/config/gfortran_avx.cfg +++ b/config/gfortran_avx.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -ffree-line-length-none -I . -mavx -g +FC : gfortran -ffree-line-length-none -I . -mavx -g LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 @@ -35,7 +35,7 @@ OPENMP : 1 ; Append OpenMP flags # -ffast-math and the Fortran-specific # -fno-protect-parens and -fstack-arrays. [OPT] -FCFLAGS : -Ofast +FCFLAGS : -Ofast -march=native # Profiling flags ################# diff --git a/config/gfortran_debug.cfg b/config/gfortran_debug.cfg index 4b06c5e9..f0c6e320 100644 --- a/config/gfortran_debug.cfg +++ b/config/gfortran_debug.cfg @@ -51,7 +51,7 @@ FCFLAGS : -Ofast # -g : Extra debugging information # [DEBUG] -FCFLAGS : -g -msse4.2 +FCFLAGS : -g -msse4.2 -fcheck=all -Waliasing -Wampersand -Wconversion -Wsurprising -Wintrinsics-std -Wno-tabs -Wintrinsic-shadow -Wline-truncation -Wreal-q-constant # OpenMP flags ################# diff --git a/ocaml/Input_determinants_by_hand.ml b/ocaml/Input_determinants_by_hand.ml index 76080b02..6cc83745 100644 --- a/ocaml/Input_determinants_by_hand.ml +++ b/ocaml/Input_determinants_by_hand.ml @@ -7,6 +7,7 @@ module Determinants_by_hand : sig { n_int : N_int_number.t; bit_kind : Bit_kind.t; n_det : Det_number.t; + n_states : States_number.t; expected_s2 : Positive_float.t; psi_coef : Det_coef.t array; psi_det : Determinant.t array; @@ -18,11 +19,14 @@ module Determinants_by_hand : sig val to_rst : t -> Rst_string.t val of_rst : Rst_string.t -> t option val read_n_int : unit -> N_int_number.t + val update_ndet : Det_number.t -> unit + val extract_state : States_number.t -> unit end = struct type t = { n_int : N_int_number.t; bit_kind : Bit_kind.t; n_det : Det_number.t; + n_states : States_number.t; expected_s2 : Positive_float.t; psi_coef : Det_coef.t array; psi_det : Determinant.t array; @@ -129,12 +133,12 @@ end = struct |> Array.map ~f:Det_coef.of_float ;; - let write_psi_coef ~n_det c = + let write_psi_coef ~n_det ~n_states c = let n_det = Det_number.to_int n_det and c = Array.to_list c |> List.map ~f:Det_coef.to_float and n_states = - read_n_states () |> States_number.to_int + States_number.to_int n_states in Ezfio.ezfio_array_of_list ~rank:2 ~dim:[| n_det ; n_states |] ~data:c |> Ezfio.set_determinants_psi_coef @@ -200,6 +204,7 @@ end = struct expected_s2 = read_expected_s2 () ; psi_coef = read_psi_coef () ; psi_det = read_psi_det () ; + n_states = read_n_states () ; } else failwith "No molecular orbitals, so no determinants" @@ -222,12 +227,14 @@ end = struct expected_s2 ; psi_coef ; psi_det ; + n_states ; } = write_n_int n_int ; write_bit_kind bit_kind; write_n_det n_det; + write_n_states n_states; write_expected_s2 expected_s2; - write_psi_coef ~n_det:n_det psi_coef ; + write_psi_coef ~n_det:n_det ~n_states:n_states psi_coef ; write_psi_det ~n_int:n_int ~n_det:n_det psi_det; ;; @@ -298,6 +305,7 @@ Determinants :: n_int = %s bit_kind = %s n_det = %s +n_states = %s expected_s2 = %s psi_coef = %s psi_det = %s @@ -305,6 +313,7 @@ psi_det = %s (b.n_int |> N_int_number.to_string) (b.bit_kind |> Bit_kind.to_string) (b.n_det |> Det_number.to_string) + (b.n_states |> States_number.to_string) (b.expected_s2 |> Positive_float.to_string) (b.psi_coef |> Array.to_list |> List.map ~f:Det_coef.to_string |> String.concat ~sep:", ") @@ -433,14 +442,83 @@ psi_det = %s |> Bit_kind.to_int) and n_int = Printf.sprintf "(n_int %d)" (N_int_number.get_max ()) + and n_states = + Printf.sprintf "(n_states %d)" (States_number.to_int @@ read_n_states ()) in let s = - String.concat [ header ; bitkind ; n_int ; psi_coef ; psi_det] + String.concat [ header ; bitkind ; n_int ; n_states ; psi_coef ; psi_det] in + + + Generic_input_of_rst.evaluate_sexp t_of_sexp s ;; + let update_ndet n_det_new = + Printf.printf "Reducing n_det to %d\n" (Det_number.to_int n_det_new); + let n_det_new = + Det_number.to_int n_det_new + in + let det = + read () + in + let n_det_old, n_states = + Det_number.to_int det.n_det, + States_number.to_int det.n_states + in + if n_det_new = n_det_old then + () + ; + if n_det_new > n_det_new then + failwith @@ Printf.sprintf "Requested n_det should be less than %d" n_det_old + ; + for j=0 to (n_states-1) do + let ishift_old, ishift_new = + j*n_det_old, + j*n_det_new + in + for i=0 to (n_det_new-1) do + det.psi_coef.(i+ishift_new) <- det.psi_coef.(i+ishift_old) + done + done + ; + let new_det = + { det with n_det = (Det_number.of_int n_det_new) } + in + write new_det + ;; + + let extract_state istate = + Printf.printf "Extracting state %d\n" (States_number.to_int istate); + let det = + read () + in + let n_det, n_states = + Det_number.to_int det.n_det, + States_number.to_int det.n_states + in + if (States_number.to_int istate) > n_states then + failwith "State to extract should not be greater than n_states" + ; + let j = + (States_number.to_int istate) - 1 + in + begin + if (j>0) then + let ishift = + j*n_det + in + for i=0 to (n_det-1) do + det.psi_coef.(i) <- det.psi_coef.(i+ishift) + done + end; + let new_det = + { det with n_states = (States_number.of_int 1) } + in + write new_det + ;; + end diff --git a/ocaml/Symmetry.ml b/ocaml/Symmetry.ml index 5849e116..8647ae99 100644 --- a/ocaml/Symmetry.ml +++ b/ocaml/Symmetry.ml @@ -85,7 +85,7 @@ module Xyz = struct let of_string s = let flush state accu number = let n = - if (number = "") then 0 + if (number = "") then 1 else (Int.of_string number) in match state with diff --git a/ocaml/TaskServer.ml b/ocaml/TaskServer.ml index a1625719..abc2de1d 100644 --- a/ocaml/TaskServer.ml +++ b/ocaml/TaskServer.ml @@ -47,6 +47,14 @@ let debug str = let zmq_context = ZMQ.Context.create () +let () = + let nproc = + match Sys.getenv "OMP_NUM_THREADS" with + | Some m -> int_of_string m + | None -> 2 + in + ZMQ.Context.set_io_threads zmq_context nproc + let bind_socket ~socket_type ~socket ~port = let rec loop = function diff --git a/ocaml/qp_create_ezfio_from_xyz.ml b/ocaml/qp_create_ezfio_from_xyz.ml index c79bf550..7c07ffe5 100644 --- a/ocaml/qp_create_ezfio_from_xyz.ml +++ b/ocaml/qp_create_ezfio_from_xyz.ml @@ -21,6 +21,9 @@ let spec = ~doc:" Compute AOs in the Cartesian basis set (6d, 10f, ...)" +> anon ("(xyz_file|zmt_file)" %: file ) +type element = +| Element of Element.t +| Int_elem of (Nucl_number.t * Element.t) (** Handle dummy atoms placed on bonds *) let dummy_centers ~threshold ~molecule ~nuclei = @@ -115,17 +118,14 @@ let run ?o b c d m p cart xyz_file = (* Open basis set channels *) let basis_channel element = let key = - Element.to_string element + match element with + | Element e -> Element.to_string e + | Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e) in match Hashtbl.find basis_table key with | Some in_channel -> in_channel - | None -> - let msg = - Printf.sprintf "%s is not defined in basis %s.%!" - (Element.to_long_string element) b ; - in - failwith msg + | None -> raise Not_found in let temp_filename = @@ -189,12 +189,21 @@ let run ?o b c d m p cart xyz_file = | Some (key, basis) -> (*Aux basis *) begin let elem = - Element.of_string key + try + Element (Element.of_string key) + with Element.ElementError _ -> + let result = + match (String.split ~on:',' key) with + | i :: k :: [] -> (Nucl_number.of_int @@ int_of_string i, Element.of_string k) + | _ -> failwith "Expected format is int,Element:basis" + in Int_elem result and basis = String.lowercase basis in let key = - Element.to_string elem + match elem with + | Element e -> Element.to_string e + | Int_elem (i,e) -> Printf.sprintf "%d,%s" (Nucl_number.to_int i) (Element.to_string e) in let new_channel = fetch_channel basis @@ -202,7 +211,13 @@ let run ?o b c d m p cart xyz_file = begin match Hashtbl.add basis_table ~key:key ~data:new_channel with | `Ok -> () - | `Duplicate -> failwith ("Duplicate definition of basis for "^(Element.to_long_string elem)) + | `Duplicate -> + let e = + match elem with + | Element e -> e + | Int_elem (_,e) -> e + in + failwith ("Duplicate definition of basis for "^(Element.to_long_string e)) end end end; @@ -537,7 +552,20 @@ let run ?o b c d m p cart xyz_file = | Element.X -> Element.H | e -> e in - Basis.read_element (basis_channel x.Atom.element) i e + let key = + Int_elem (i,x.Atom.element) + in + try + Basis.read_element (basis_channel key) i e + with Not_found -> + let key = + Element x.Atom.element + in + try + Basis.read_element (basis_channel key) i e + with Not_found -> + failwith (Printf.sprintf "Basis not found for atom %d (%s)" (Nucl_number.to_int i) + (Element.to_string x.Atom.element) ) with | End_of_file -> failwith ("Element "^(Element.to_string x.Atom.element)^" not found in basis set.") @@ -647,6 +675,7 @@ atoms are taken from the same basis set, otherwise specific elements can be defined as follows: -b \"cc-pcvdz | H:cc-pvdz | C:6-31g\" + -b \"cc-pvtz | 1,H:sto-3g | 3,H:6-31g\" If a file with the same name as the basis set exists, this file will be read. Otherwise, the basis set is obtained from the database. diff --git a/plugins/CAS_SD_ZMQ/run_selection_slave.irp.f b/plugins/CAS_SD_ZMQ/run_selection_slave.irp.f index e200322f..ff5dd509 100644 --- a/plugins/CAS_SD_ZMQ/run_selection_slave.irp.f +++ b/plugins/CAS_SD_ZMQ/run_selection_slave.irp.f @@ -41,8 +41,8 @@ subroutine run_selection_slave(thread,iproc,energy) if (done) then ctask = ctask - 1 else - integer :: i_generator, i_generator_start, i_generator_max, step, N - read (task,*) i_generator_start, i_generator_max, step, N + integer :: i_generator, N + read (task,*) i_generator, N if(buf%N == 0) then ! Only first time call create_selection_buffer(N, N*2, buf) @@ -50,9 +50,7 @@ subroutine run_selection_slave(thread,iproc,energy) else if(N /= buf%N) stop "N changed... wtf man??" end if - do i_generator=i_generator_start,i_generator_max,step - call select_connected(i_generator,energy,pt2,buf) - enddo + call select_connected(i_generator,energy,pt2,buf) endif if(done .or. ctask == size(task_id)) then diff --git a/plugins/CAS_SD_ZMQ/selection.irp.f b/plugins/CAS_SD_ZMQ/selection.irp.f index c5285bdf..ddad71db 100644 --- a/plugins/CAS_SD_ZMQ/selection.irp.f +++ b/plugins/CAS_SD_ZMQ/selection.irp.f @@ -671,13 +671,9 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d if(mat(1, p1, p2) == 0d0) cycle call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) logical, external :: is_in_wavefunction - if (is_in_wavefunction(det,N_int)) then - stop 'is_in_wf' - cycle - endif if (do_ddci) then - integer, external :: is_a_two_holes_two_particles + logical, external :: is_a_two_holes_two_particles if (is_a_two_holes_two_particles(det)) then cycle endif @@ -1219,35 +1215,42 @@ subroutine ZMQ_selection(N_in, pt2) implicit none - character*(512) :: task integer(ZMQ_PTR) :: zmq_to_qp_run_socket integer, intent(in) :: N_in type(selection_buffer) :: b integer :: i, N integer, external :: omp_get_thread_num double precision, intent(out) :: pt2(N_states) + integer, parameter :: maxtasks=10000 + N = max(N_in,1) if (.True.) then PROVIDE pt2_e0_denominator - N = max(N_in,1) provide nproc call new_parallel_job(zmq_to_qp_run_socket,"selection") call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator)) - call zmq_set_running(zmq_to_qp_run_socket) call create_selection_buffer(N, N*2, b) endif - integer :: i_generator, i_generator_start, i_generator_max, step + character*(20*maxtasks) :: task + task = ' ' - step = int(5000000.d0 / dble(N_int * N_states * elec_num * elec_num * mo_tot_num * mo_tot_num )) - step = max(1,step) - do i= 1, N_det_generators,step - i_generator_start = i - i_generator_max = min(i+step-1,N_det_generators) - write(task,*) i_generator_start, i_generator_max, 1, N + integer :: k + k=0 + do i= 1, N_det_generators + k = k+1 + write(task(20*(k-1)+1:20*k),'(I9,1X,I9,''|'')') i, N + k = k+20 + if (k>20*maxtasks) then + k=0 + call add_task_to_taskserver(zmq_to_qp_run_socket,task) + endif + enddo + if (k > 0) then call add_task_to_taskserver(zmq_to_qp_run_socket,task) - end do + endif + call zmq_set_running(zmq_to_qp_run_socket) !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() @@ -1264,6 +1267,7 @@ subroutine ZMQ_selection(N_in, pt2) if (s2_eig) then call make_s2_eigenfunction endif + call save_wavefunction endif end subroutine diff --git a/plugins/DFT_Utils/EZFIO.cfg b/plugins/DFT_Utils/EZFIO.cfg deleted file mode 100644 index 21cc5b98..00000000 --- a/plugins/DFT_Utils/EZFIO.cfg +++ /dev/null @@ -1,4 +0,0 @@ -[energy] -type: double precision -doc: Calculated energy -interface: ezfio diff --git a/plugins/DFT_Utils/angular.f b/plugins/DFT_Utils/angular.f new file mode 100644 index 00000000..a5052a32 --- /dev/null +++ b/plugins/DFT_Utils/angular.f @@ -0,0 +1,6951 @@ + subroutine gen_oh(code, num, x, y, z, w, a, b, v) + implicit logical(a-z) + double precision x(*),y(*),z(*),w(*) + double precision a,b,v + integer code + integer num + double precision c +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated from C to fortran77 by hand. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd +cvw +cvw Given a point on a sphere (specified by a and b), generate all +cvw the equivalent points under Oh symmetry, making grid points with +cvw weight v. +cvw The variable num is increased by the number of different points +cvw generated. +cvw +cvw Depending on code, there are 6...48 different but equivalent +cvw points. +cvw +cvw code=1: (0,0,1) etc ( 6 points) +cvw code=2: (0,a,a) etc, a=1/sqrt(2) ( 12 points) +cvw code=3: (a,a,a) etc, a=1/sqrt(3) ( 8 points) +cvw code=4: (a,a,b) etc, b=sqrt(1-2 a^2) ( 24 points) +cvw code=5: (a,b,0) etc, b=sqrt(1-a^2), a input ( 24 points) +cvw code=6: (a,b,c) etc, c=sqrt(1-a^2-b^2), a/b input ( 48 points) +cvw + goto (1,2,3,4,5,6) code + write (6,*) 'Gen_Oh: Invalid Code' + stop + 1 continue + a=1.0d0 + x(1) = a + y(1) = 0.0d0 + z(1) = 0.0d0 + w(1) = v + x(2) = -a + y(2) = 0.0d0 + z(2) = 0.0d0 + w(2) = v + x(3) = 0.0d0 + y(3) = a + z(3) = 0.0d0 + w(3) = v + x(4) = 0.0d0 + y(4) = -a + z(4) = 0.0d0 + w(4) = v + x(5) = 0.0d0 + y(5) = 0.0d0 + z(5) = a + w(5) = v + x(6) = 0.0d0 + y(6) = 0.0d0 + z(6) = -a + w(6) = v + num=num+6 + return +cvw + 2 continue + a=sqrt(0.5d0) + x( 1) = 0d0 + y( 1) = a + z( 1) = a + w( 1) = v + x( 2) = 0d0 + y( 2) = -a + z( 2) = a + w( 2) = v + x( 3) = 0d0 + y( 3) = a + z( 3) = -a + w( 3) = v + x( 4) = 0d0 + y( 4) = -a + z( 4) = -a + w( 4) = v + x( 5) = a + y( 5) = 0d0 + z( 5) = a + w( 5) = v + x( 6) = -a + y( 6) = 0d0 + z( 6) = a + w( 6) = v + x( 7) = a + y( 7) = 0d0 + z( 7) = -a + w( 7) = v + x( 8) = -a + y( 8) = 0d0 + z( 8) = -a + w( 8) = v + x( 9) = a + y( 9) = a + z( 9) = 0d0 + w( 9) = v + x(10) = -a + y(10) = a + z(10) = 0d0 + w(10) = v + x(11) = a + y(11) = -a + z(11) = 0d0 + w(11) = v + x(12) = -a + y(12) = -a + z(12) = 0d0 + w(12) = v + num=num+12 + return +cvw + 3 continue + a = sqrt(1d0/3d0) + x(1) = a + y(1) = a + z(1) = a + w(1) = v + x(2) = -a + y(2) = a + z(2) = a + w(2) = v + x(3) = a + y(3) = -a + z(3) = a + w(3) = v + x(4) = -a + y(4) = -a + z(4) = a + w(4) = v + x(5) = a + y(5) = a + z(5) = -a + w(5) = v + x(6) = -a + y(6) = a + z(6) = -a + w(6) = v + x(7) = a + y(7) = -a + z(7) = -a + w(7) = v + x(8) = -a + y(8) = -a + z(8) = -a + w(8) = v + num=num+8 + return +cvw + 4 continue + b = sqrt(1d0 - 2d0*a*a) + x( 1) = a + y( 1) = a + z( 1) = b + w( 1) = v + x( 2) = -a + y( 2) = a + z( 2) = b + w( 2) = v + x( 3) = a + y( 3) = -a + z( 3) = b + w( 3) = v + x( 4) = -a + y( 4) = -a + z( 4) = b + w( 4) = v + x( 5) = a + y( 5) = a + z( 5) = -b + w( 5) = v + x( 6) = -a + y( 6) = a + z( 6) = -b + w( 6) = v + x( 7) = a + y( 7) = -a + z( 7) = -b + w( 7) = v + x( 8) = -a + y( 8) = -a + z( 8) = -b + w( 8) = v + x( 9) = a + y( 9) = b + z( 9) = a + w( 9) = v + x(10) = -a + y(10) = b + z(10) = a + w(10) = v + x(11) = a + y(11) = -b + z(11) = a + w(11) = v + x(12) = -a + y(12) = -b + z(12) = a + w(12) = v + x(13) = a + y(13) = b + z(13) = -a + w(13) = v + x(14) = -a + y(14) = b + z(14) = -a + w(14) = v + x(15) = a + y(15) = -b + z(15) = -a + w(15) = v + x(16) = -a + y(16) = -b + z(16) = -a + w(16) = v + x(17) = b + y(17) = a + z(17) = a + w(17) = v + x(18) = -b + y(18) = a + z(18) = a + w(18) = v + x(19) = b + y(19) = -a + z(19) = a + w(19) = v + x(20) = -b + y(20) = -a + z(20) = a + w(20) = v + x(21) = b + y(21) = a + z(21) = -a + w(21) = v + x(22) = -b + y(22) = a + z(22) = -a + w(22) = v + x(23) = b + y(23) = -a + z(23) = -a + w(23) = v + x(24) = -b + y(24) = -a + z(24) = -a + w(24) = v + num=num+24 + return +cvw + 5 continue + b=sqrt(1d0-a*a) + x( 1) = a + y( 1) = b + z( 1) = 0d0 + w( 1) = v + x( 2) = -a + y( 2) = b + z( 2) = 0d0 + w( 2) = v + x( 3) = a + y( 3) = -b + z( 3) = 0d0 + w( 3) = v + x( 4) = -a + y( 4) = -b + z( 4) = 0d0 + w( 4) = v + x( 5) = b + y( 5) = a + z( 5) = 0d0 + w( 5) = v + x( 6) = -b + y( 6) = a + z( 6) = 0d0 + w( 6) = v + x( 7) = b + y( 7) = -a + z( 7) = 0d0 + w( 7) = v + x( 8) = -b + y( 8) = -a + z( 8) = 0d0 + w( 8) = v + x( 9) = a + y( 9) = 0d0 + z( 9) = b + w( 9) = v + x(10) = -a + y(10) = 0d0 + z(10) = b + w(10) = v + x(11) = a + y(11) = 0d0 + z(11) = -b + w(11) = v + x(12) = -a + y(12) = 0d0 + z(12) = -b + w(12) = v + x(13) = b + y(13) = 0d0 + z(13) = a + w(13) = v + x(14) = -b + y(14) = 0d0 + z(14) = a + w(14) = v + x(15) = b + y(15) = 0d0 + z(15) = -a + w(15) = v + x(16) = -b + y(16) = 0d0 + z(16) = -a + w(16) = v + x(17) = 0d0 + y(17) = a + z(17) = b + w(17) = v + x(18) = 0d0 + y(18) = -a + z(18) = b + w(18) = v + x(19) = 0d0 + y(19) = a + z(19) = -b + w(19) = v + x(20) = 0d0 + y(20) = -a + z(20) = -b + w(20) = v + x(21) = 0d0 + y(21) = b + z(21) = a + w(21) = v + x(22) = 0d0 + y(22) = -b + z(22) = a + w(22) = v + x(23) = 0d0 + y(23) = b + z(23) = -a + w(23) = v + x(24) = 0d0 + y(24) = -b + z(24) = -a + w(24) = v + num=num+24 + return +cvw + 6 continue + c=sqrt(1d0 - a*a - b*b) + x( 1) = a + y( 1) = b + z( 1) = c + w( 1) = v + x( 2) = -a + y( 2) = b + z( 2) = c + w( 2) = v + x( 3) = a + y( 3) = -b + z( 3) = c + w( 3) = v + x( 4) = -a + y( 4) = -b + z( 4) = c + w( 4) = v + x( 5) = a + y( 5) = b + z( 5) = -c + w( 5) = v + x( 6) = -a + y( 6) = b + z( 6) = -c + w( 6) = v + x( 7) = a + y( 7) = -b + z( 7) = -c + w( 7) = v + x( 8) = -a + y( 8) = -b + z( 8) = -c + w( 8) = v + x( 9) = a + y( 9) = c + z( 9) = b + w( 9) = v + x(10) = -a + y(10) = c + z(10) = b + w(10) = v + x(11) = a + y(11) = -c + z(11) = b + w(11) = v + x(12) = -a + y(12) = -c + z(12) = b + w(12) = v + x(13) = a + y(13) = c + z(13) = -b + w(13) = v + x(14) = -a + y(14) = c + z(14) = -b + w(14) = v + x(15) = a + y(15) = -c + z(15) = -b + w(15) = v + x(16) = -a + y(16) = -c + z(16) = -b + w(16) = v + x(17) = b + y(17) = a + z(17) = c + w(17) = v + x(18) = -b + y(18) = a + z(18) = c + w(18) = v + x(19) = b + y(19) = -a + z(19) = c + w(19) = v + x(20) = -b + y(20) = -a + z(20) = c + w(20) = v + x(21) = b + y(21) = a + z(21) = -c + w(21) = v + x(22) = -b + y(22) = a + z(22) = -c + w(22) = v + x(23) = b + y(23) = -a + z(23) = -c + w(23) = v + x(24) = -b + y(24) = -a + z(24) = -c + w(24) = v + x(25) = b + y(25) = c + z(25) = a + w(25) = v + x(26) = -b + y(26) = c + z(26) = a + w(26) = v + x(27) = b + y(27) = -c + z(27) = a + w(27) = v + x(28) = -b + y(28) = -c + z(28) = a + w(28) = v + x(29) = b + y(29) = c + z(29) = -a + w(29) = v + x(30) = -b + y(30) = c + z(30) = -a + w(30) = v + x(31) = b + y(31) = -c + z(31) = -a + w(31) = v + x(32) = -b + y(32) = -c + z(32) = -a + w(32) = v + x(33) = c + y(33) = a + z(33) = b + w(33) = v + x(34) = -c + y(34) = a + z(34) = b + w(34) = v + x(35) = c + y(35) = -a + z(35) = b + w(35) = v + x(36) = -c + y(36) = -a + z(36) = b + w(36) = v + x(37) = c + y(37) = a + z(37) = -b + w(37) = v + x(38) = -c + y(38) = a + z(38) = -b + w(38) = v + x(39) = c + y(39) = -a + z(39) = -b + w(39) = v + x(40) = -c + y(40) = -a + z(40) = -b + w(40) = v + x(41) = c + y(41) = b + z(41) = a + w(41) = v + x(42) = -c + y(42) = b + z(42) = a + w(42) = v + x(43) = c + y(43) = -b + z(43) = a + w(43) = v + x(44) = -c + y(44) = -b + z(44) = a + w(44) = v + x(45) = c + y(45) = b + z(45) = -a + w(45) = v + x(46) = -c + y(46) = b + z(46) = -a + w(46) = v + x(47) = c + y(47) = -b + z(47) = -a + w(47) = v + x(48) = -c + y(48) = -b + z(48) = -a + w(48) = v + num=num+48 + return + end + SUBROUTINE LD0006(X,Y,Z,W,N) + DOUBLE PRECISION X( 6) + DOUBLE PRECISION Y( 6) + DOUBLE PRECISION Z( 6) + DOUBLE PRECISION W( 6) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 6-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1666666666666667D+0 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0014(X,Y,Z,W,N) + DOUBLE PRECISION X( 14) + DOUBLE PRECISION Y( 14) + DOUBLE PRECISION Z( 14) + DOUBLE PRECISION W( 14) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 14-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.6666666666666667D-1 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.7500000000000000D-1 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0026(X,Y,Z,W,N) + DOUBLE PRECISION X( 26) + DOUBLE PRECISION Y( 26) + DOUBLE PRECISION Z( 26) + DOUBLE PRECISION W( 26) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 26-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.4761904761904762D-1 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3809523809523810D-1 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3214285714285714D-1 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0038(X,Y,Z,W,N) + DOUBLE PRECISION X( 38) + DOUBLE PRECISION Y( 38) + DOUBLE PRECISION Z( 38) + DOUBLE PRECISION W( 38) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 38-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.9523809523809524D-2 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3214285714285714D-1 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4597008433809831D+0 + V=0.2857142857142857D-1 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0050(X,Y,Z,W,N) + DOUBLE PRECISION X( 50) + DOUBLE PRECISION Y( 50) + DOUBLE PRECISION Z( 50) + DOUBLE PRECISION W( 50) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 50-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1269841269841270D-1 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2257495590828924D-1 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2109375000000000D-1 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3015113445777636D+0 + V=0.2017333553791887D-1 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0074(X,Y,Z,W,N) + DOUBLE PRECISION X( 74) + DOUBLE PRECISION Y( 74) + DOUBLE PRECISION Z( 74) + DOUBLE PRECISION W( 74) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 74-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.5130671797338464D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1660406956574204D-1 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=-0.2958603896103896D-1 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4803844614152614D+0 + V=0.2657620708215946D-1 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3207726489807764D+0 + V=0.1652217099371571D-1 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0086(X,Y,Z,W,N) + DOUBLE PRECISION X( 86) + DOUBLE PRECISION Y( 86) + DOUBLE PRECISION Z( 86) + DOUBLE PRECISION W( 86) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 86-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1154401154401154D-1 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1194390908585628D-1 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3696028464541502D+0 + V=0.1111055571060340D-1 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6943540066026664D+0 + V=0.1187650129453714D-1 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3742430390903412D+0 + V=0.1181230374690448D-1 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0110(X,Y,Z,W,N) + DOUBLE PRECISION X( 110) + DOUBLE PRECISION Y( 110) + DOUBLE PRECISION Z( 110) + DOUBLE PRECISION W( 110) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 110-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.3828270494937162D-2 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.9793737512487512D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1851156353447362D+0 + V=0.8211737283191111D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6904210483822922D+0 + V=0.9942814891178103D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3956894730559419D+0 + V=0.9595471336070963D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4783690288121502D+0 + V=0.9694996361663028D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0146(X,Y,Z,W,N) + DOUBLE PRECISION X( 146) + DOUBLE PRECISION Y( 146) + DOUBLE PRECISION Z( 146) + DOUBLE PRECISION W( 146) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 146-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.5996313688621381D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.7372999718620756D-2 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.7210515360144488D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6764410400114264D+0 + V=0.7116355493117555D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4174961227965453D+0 + V=0.6753829486314477D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1574676672039082D+0 + V=0.7574394159054034D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1403553811713183D+0 + B=0.4493328323269557D+0 + V=0.6991087353303262D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0170(X,Y,Z,W,N) + DOUBLE PRECISION X( 170) + DOUBLE PRECISION Y( 170) + DOUBLE PRECISION Z( 170) + DOUBLE PRECISION W( 170) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 170-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.5544842902037365D-2 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.6071332770670752D-2 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.6383674773515093D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2551252621114134D+0 + V=0.5183387587747790D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6743601460362766D+0 + V=0.6317929009813725D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4318910696719410D+0 + V=0.6201670006589077D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2613931360335988D+0 + V=0.5477143385137348D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4990453161796037D+0 + B=0.1446630744325115D+0 + V=0.5968383987681156D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0194(X,Y,Z,W,N) + DOUBLE PRECISION X( 194) + DOUBLE PRECISION Y( 194) + DOUBLE PRECISION Z( 194) + DOUBLE PRECISION W( 194) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 194-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1782340447244611D-2 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.5716905949977102D-2 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.5573383178848738D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6712973442695226D+0 + V=0.5608704082587997D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2892465627575439D+0 + V=0.5158237711805383D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4446933178717437D+0 + V=0.5518771467273614D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1299335447650067D+0 + V=0.4106777028169394D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3457702197611283D+0 + V=0.5051846064614808D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1590417105383530D+0 + B=0.8360360154824589D+0 + V=0.5530248916233094D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0230(X,Y,Z,W,N) + DOUBLE PRECISION X( 230) + DOUBLE PRECISION Y( 230) + DOUBLE PRECISION Z( 230) + DOUBLE PRECISION W( 230) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 230-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=-0.5522639919727325D-1 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.4450274607445226D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4492044687397611D+0 + V=0.4496841067921404D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2520419490210201D+0 + V=0.5049153450478750D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6981906658447242D+0 + V=0.3976408018051883D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6587405243460960D+0 + V=0.4401400650381014D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4038544050097660D-1 + V=0.1724544350544401D-1 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5823842309715585D+0 + V=0.4231083095357343D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3545877390518688D+0 + V=0.5198069864064399D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2272181808998187D+0 + B=0.4864661535886647D+0 + V=0.4695720972568883D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0266(X,Y,Z,W,N) + DOUBLE PRECISION X( 266) + DOUBLE PRECISION Y( 266) + DOUBLE PRECISION Z( 266) + DOUBLE PRECISION W( 266) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 266-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=-0.1313769127326952D-2 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=-0.2522728704859336D-2 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.4186853881700583D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7039373391585475D+0 + V=0.5315167977810885D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1012526248572414D+0 + V=0.4047142377086219D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4647448726420539D+0 + V=0.4112482394406990D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3277420654971629D+0 + V=0.3595584899758782D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6620338663699974D+0 + V=0.4256131351428158D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8506508083520399D+0 + V=0.4229582700647240D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3233484542692899D+0 + B=0.1153112011009701D+0 + V=0.4080914225780505D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2314790158712601D+0 + B=0.5244939240922365D+0 + V=0.4071467593830964D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0302(X,Y,Z,W,N) + DOUBLE PRECISION X( 302) + DOUBLE PRECISION Y( 302) + DOUBLE PRECISION Z( 302) + DOUBLE PRECISION W( 302) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 302-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.8545911725128148D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3599119285025571D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3515640345570105D+0 + V=0.3449788424305883D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6566329410219612D+0 + V=0.3604822601419882D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4729054132581005D+0 + V=0.3576729661743367D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9618308522614784D-1 + V=0.2352101413689164D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2219645236294178D+0 + V=0.3108953122413675D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7011766416089545D+0 + V=0.3650045807677255D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2644152887060663D+0 + V=0.2982344963171804D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5718955891878961D+0 + V=0.3600820932216460D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2510034751770465D+0 + B=0.8000727494073952D+0 + V=0.3571540554273387D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1233548532583327D+0 + B=0.4127724083168531D+0 + V=0.3392312205006170D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0350(X,Y,Z,W,N) + DOUBLE PRECISION X( 350) + DOUBLE PRECISION Y( 350) + DOUBLE PRECISION Z( 350) + DOUBLE PRECISION W( 350) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 350-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.3006796749453936D-2 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3050627745650771D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7068965463912316D+0 + V=0.1621104600288991D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4794682625712025D+0 + V=0.3005701484901752D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1927533154878019D+0 + V=0.2990992529653774D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6930357961327123D+0 + V=0.2982170644107595D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3608302115520091D+0 + V=0.2721564237310992D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6498486161496169D+0 + V=0.3033513795811141D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1932945013230339D+0 + V=0.3007949555218533D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3800494919899303D+0 + V=0.2881964603055307D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2899558825499574D+0 + B=0.7934537856582316D+0 + V=0.2958357626535696D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9684121455103957D-1 + B=0.8280801506686862D+0 + V=0.3036020026407088D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1833434647041659D+0 + B=0.9074658265305127D+0 + V=0.2832187403926303D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0434(X,Y,Z,W,N) + DOUBLE PRECISION X( 434) + DOUBLE PRECISION Y( 434) + DOUBLE PRECISION Z( 434) + DOUBLE PRECISION W( 434) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 434-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.5265897968224436D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2548219972002607D-2 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2512317418927307D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6909346307509111D+0 + V=0.2530403801186355D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1774836054609158D+0 + V=0.2014279020918528D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4914342637784746D+0 + V=0.2501725168402936D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6456664707424256D+0 + V=0.2513267174597564D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2861289010307638D+0 + V=0.2302694782227416D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7568084367178018D-1 + V=0.1462495621594614D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3927259763368002D+0 + V=0.2445373437312980D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8818132877794288D+0 + V=0.2417442375638981D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9776428111182649D+0 + V=0.1910951282179532D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2054823696403044D+0 + B=0.8689460322872412D+0 + V=0.2416930044324775D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5905157048925271D+0 + B=0.7999278543857286D+0 + V=0.2512236854563495D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5550152361076807D+0 + B=0.7717462626915901D+0 + V=0.2496644054553086D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9371809858553722D+0 + B=0.3344363145343455D+0 + V=0.2236607760437849D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0590(X,Y,Z,W,N) + DOUBLE PRECISION X( 590) + DOUBLE PRECISION Y( 590) + DOUBLE PRECISION Z( 590) + DOUBLE PRECISION W( 590) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 590-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.3095121295306187D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1852379698597489D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7040954938227469D+0 + V=0.1871790639277744D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6807744066455243D+0 + V=0.1858812585438317D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6372546939258752D+0 + V=0.1852028828296213D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5044419707800358D+0 + V=0.1846715956151242D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4215761784010967D+0 + V=0.1818471778162769D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3317920736472123D+0 + V=0.1749564657281154D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2384736701421887D+0 + V=0.1617210647254411D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1459036449157763D+0 + V=0.1384737234851692D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6095034115507196D-1 + V=0.9764331165051050D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6116843442009876D+0 + V=0.1857161196774078D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3964755348199858D+0 + V=0.1705153996395864D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1724782009907724D+0 + V=0.1300321685886048D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5610263808622060D+0 + B=0.3518280927733519D+0 + V=0.1842866472905286D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4742392842551980D+0 + B=0.2634716655937950D+0 + V=0.1802658934377451D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5984126497885380D+0 + B=0.1816640840360209D+0 + V=0.1849830560443660D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3791035407695563D+0 + B=0.1720795225656878D+0 + V=0.1713904507106709D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2778673190586244D+0 + B=0.8213021581932511D-1 + V=0.1555213603396808D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5033564271075117D+0 + B=0.8999205842074875D-1 + V=0.1802239128008525D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0770(X,Y,Z,W,N) + DOUBLE PRECISION X( 770) + DOUBLE PRECISION Y( 770) + DOUBLE PRECISION Z( 770) + DOUBLE PRECISION W( 770) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 770-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.2192942088181184D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1436433617319080D-2 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1421940344335877D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5087204410502360D-1 + V=0.6798123511050502D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1228198790178831D+0 + V=0.9913184235294912D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2026890814408786D+0 + V=0.1180207833238949D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2847745156464294D+0 + V=0.1296599602080921D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3656719078978026D+0 + V=0.1365871427428316D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4428264886713469D+0 + V=0.1402988604775325D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5140619627249735D+0 + V=0.1418645563595609D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6306401219166803D+0 + V=0.1421376741851662D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6716883332022612D+0 + V=0.1423996475490962D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6979792685336881D+0 + V=0.1431554042178567D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1446865674195309D+0 + V=0.9254401499865368D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3390263475411216D+0 + V=0.1250239995053509D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5335804651263506D+0 + V=0.1394365843329230D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6944024393349413D-1 + B=0.2355187894242326D+0 + V=0.1127089094671749D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2269004109529460D+0 + B=0.4102182474045730D+0 + V=0.1345753760910670D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8025574607775339D-1 + B=0.6214302417481605D+0 + V=0.1424957283316783D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1467999527896572D+0 + B=0.3245284345717394D+0 + V=0.1261523341237750D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1571507769824727D+0 + B=0.5224482189696630D+0 + V=0.1392547106052696D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2365702993157246D+0 + B=0.6017546634089558D+0 + V=0.1418761677877656D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7714815866765732D-1 + B=0.4346575516141163D+0 + V=0.1338366684479554D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3062936666210730D+0 + B=0.4908826589037616D+0 + V=0.1393700862676131D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3822477379524787D+0 + B=0.5648768149099500D+0 + V=0.1415914757466932D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD0974(X,Y,Z,W,N) + DOUBLE PRECISION X( 974) + DOUBLE PRECISION Y( 974) + DOUBLE PRECISION Z( 974) + DOUBLE PRECISION W( 974) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 974-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1438294190527431D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1125772288287004D-2 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4292963545341347D-1 + V=0.4948029341949241D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1051426854086404D+0 + V=0.7357990109125470D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1750024867623087D+0 + V=0.8889132771304384D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2477653379650257D+0 + V=0.9888347838921435D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3206567123955957D+0 + V=0.1053299681709471D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3916520749849983D+0 + V=0.1092778807014578D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4590825874187624D+0 + V=0.1114389394063227D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5214563888415861D+0 + V=0.1123724788051555D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6253170244654199D+0 + V=0.1125239325243814D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6637926744523170D+0 + V=0.1126153271815905D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6910410398498301D+0 + V=0.1130286931123841D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7052907007457760D+0 + V=0.1134986534363955D-2 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1236686762657990D+0 + V=0.6823367927109931D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2940777114468387D+0 + V=0.9454158160447096D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4697753849207649D+0 + V=0.1074429975385679D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6334563241139567D+0 + V=0.1129300086569132D-2 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5974048614181342D-1 + B=0.2029128752777523D+0 + V=0.8436884500901954D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1375760408473636D+0 + B=0.4602621942484054D+0 + V=0.1075255720448885D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3391016526336286D+0 + B=0.5030673999662036D+0 + V=0.1108577236864462D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1271675191439820D+0 + B=0.2817606422442134D+0 + V=0.9566475323783357D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2693120740413512D+0 + B=0.4331561291720157D+0 + V=0.1080663250717391D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1419786452601918D+0 + B=0.6256167358580814D+0 + V=0.1126797131196295D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6709284600738255D-1 + B=0.3798395216859157D+0 + V=0.1022568715358061D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7057738183256172D-1 + B=0.5517505421423520D+0 + V=0.1108960267713108D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2783888477882155D+0 + B=0.6029619156159187D+0 + V=0.1122790653435766D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1979578938917407D+0 + B=0.3589606329589096D+0 + V=0.1032401847117460D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2087307061103274D+0 + B=0.5348666438135476D+0 + V=0.1107249382283854D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4055122137872836D+0 + B=0.5674997546074373D+0 + V=0.1121780048519972D-2 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD1202(X,Y,Z,W,N) + DOUBLE PRECISION X(1202) + DOUBLE PRECISION Y(1202) + DOUBLE PRECISION Z(1202) + DOUBLE PRECISION W(1202) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 1202-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1105189233267572D-3 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.9205232738090741D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.9133159786443561D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3712636449657089D-1 + V=0.3690421898017899D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9140060412262223D-1 + V=0.5603990928680660D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1531077852469906D+0 + V=0.6865297629282609D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2180928891660612D+0 + V=0.7720338551145630D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2839874532200175D+0 + V=0.8301545958894795D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3491177600963764D+0 + V=0.8686692550179628D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4121431461444309D+0 + V=0.8927076285846890D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4718993627149127D+0 + V=0.9060820238568219D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5273145452842337D+0 + V=0.9119777254940867D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6209475332444019D+0 + V=0.9128720138604181D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6569722711857291D+0 + V=0.9130714935691735D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6841788309070143D+0 + V=0.9152873784554116D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7012604330123631D+0 + V=0.9187436274321654D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1072382215478166D+0 + V=0.5176977312965694D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2582068959496968D+0 + V=0.7331143682101417D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4172752955306717D+0 + V=0.8463232836379928D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5700366911792503D+0 + V=0.9031122694253992D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9827986018263947D+0 + B=0.1771774022615325D+0 + V=0.6485778453163257D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9624249230326228D+0 + B=0.2475716463426288D+0 + V=0.7435030910982369D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9402007994128811D+0 + B=0.3354616289066489D+0 + V=0.7998527891839054D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9320822040143202D+0 + B=0.3173615246611977D+0 + V=0.8101731497468018D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9043674199393299D+0 + B=0.4090268427085357D+0 + V=0.8483389574594331D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8912407560074747D+0 + B=0.3854291150669224D+0 + V=0.8556299257311812D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8676435628462708D+0 + B=0.4932221184851285D+0 + V=0.8803208679738260D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8581979986041619D+0 + B=0.4785320675922435D+0 + V=0.8811048182425720D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8396753624049856D+0 + B=0.4507422593157064D+0 + V=0.8850282341265444D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8165288564022188D+0 + B=0.5632123020762100D+0 + V=0.9021342299040653D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8015469370783529D+0 + B=0.5434303569693900D+0 + V=0.9010091677105086D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7773563069070351D+0 + B=0.5123518486419871D+0 + V=0.9022692938426915D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7661621213900394D+0 + B=0.6394279634749102D+0 + V=0.9158016174693465D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7553584143533510D+0 + B=0.6269805509024392D+0 + V=0.9131578003189435D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7344305757559503D+0 + B=0.6031161693096310D+0 + V=0.9107813579482705D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7043837184021765D+0 + B=0.5693702498468441D+0 + V=0.9105760258970126D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD1454(X,Y,Z,W,N) + DOUBLE PRECISION X(1454) + DOUBLE PRECISION Y(1454) + DOUBLE PRECISION Z(1454) + DOUBLE PRECISION W(1454) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 1454-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.7777160743261247D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.7557646413004701D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3229290663413854D-1 + V=0.2841633806090617D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8036733271462222D-1 + V=0.4374419127053555D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1354289960531653D+0 + V=0.5417174740872172D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1938963861114426D+0 + V=0.6148000891358593D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2537343715011275D+0 + V=0.6664394485800705D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3135251434752570D+0 + V=0.7025039356923220D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3721558339375338D+0 + V=0.7268511789249627D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4286809575195696D+0 + V=0.7422637534208629D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4822510128282994D+0 + V=0.7509545035841214D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5320679333566263D+0 + V=0.7548535057718401D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6172998195394274D+0 + V=0.7554088969774001D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6510679849127481D+0 + V=0.7553147174442808D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6777315251687360D+0 + V=0.7564767653292297D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6963109410648741D+0 + V=0.7587991808518730D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7058935009831749D+0 + V=0.7608261832033027D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9955546194091857D+0 + V=0.4021680447874916D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9734115901794209D+0 + V=0.5804871793945964D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9275693732388626D+0 + V=0.6792151955945159D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8568022422795103D+0 + V=0.7336741211286294D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7623495553719372D+0 + V=0.7581866300989608D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5707522908892223D+0 + B=0.4387028039889501D+0 + V=0.7538257859800743D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5196463388403083D+0 + B=0.3858908414762617D+0 + V=0.7483517247053123D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4646337531215351D+0 + B=0.3301937372343854D+0 + V=0.7371763661112059D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4063901697557691D+0 + B=0.2725423573563777D+0 + V=0.7183448895756934D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3456329466643087D+0 + B=0.2139510237495250D+0 + V=0.6895815529822191D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2831395121050332D+0 + B=0.1555922309786647D+0 + V=0.6480105801792886D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2197682022925330D+0 + B=0.9892878979686097D-1 + V=0.5897558896594636D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1564696098650355D+0 + B=0.4598642910675510D-1 + V=0.5095708849247346D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6027356673721295D+0 + B=0.3376625140173426D+0 + V=0.7536906428909755D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5496032320255096D+0 + B=0.2822301309727988D+0 + V=0.7472505965575118D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4921707755234567D+0 + B=0.2248632342592540D+0 + V=0.7343017132279698D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4309422998598483D+0 + B=0.1666224723456479D+0 + V=0.7130871582177445D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3664108182313672D+0 + B=0.1086964901822169D+0 + V=0.6817022032112776D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2990189057758436D+0 + B=0.5251989784120085D-1 + V=0.6380941145604121D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6268724013144998D+0 + B=0.2297523657550023D+0 + V=0.7550381377920310D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5707324144834607D+0 + B=0.1723080607093800D+0 + V=0.7478646640144802D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5096360901960365D+0 + B=0.1140238465390513D+0 + V=0.7335918720601220D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4438729938312456D+0 + B=0.5611522095882537D-1 + V=0.7110120527658118D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6419978471082389D+0 + B=0.1164174423140873D+0 + V=0.7571363978689501D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5817218061802611D+0 + B=0.5797589531445219D-1 + V=0.7489908329079234D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD1730(X,Y,Z,W,N) + DOUBLE PRECISION X(1730) + DOUBLE PRECISION Y(1730) + DOUBLE PRECISION Z(1730) + DOUBLE PRECISION W(1730) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 1730-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.6309049437420976D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.6398287705571748D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.6357185073530720D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2860923126194662D-1 + V=0.2221207162188168D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7142556767711522D-1 + V=0.3475784022286848D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1209199540995559D+0 + V=0.4350742443589804D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1738673106594379D+0 + V=0.4978569136522127D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2284645438467734D+0 + V=0.5435036221998053D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2834807671701512D+0 + V=0.5765913388219542D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3379680145467339D+0 + V=0.6001200359226003D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3911355454819537D+0 + V=0.6162178172717512D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4422860353001403D+0 + V=0.6265218152438485D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4907781568726057D+0 + V=0.6323987160974212D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5360006153211468D+0 + V=0.6350767851540569D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6142105973596603D+0 + V=0.6354362775297107D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6459300387977504D+0 + V=0.6352302462706235D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6718056125089225D+0 + V=0.6358117881417972D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6910888533186254D+0 + V=0.6373101590310117D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7030467416823252D+0 + V=0.6390428961368665D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8354951166354646D-1 + V=0.3186913449946576D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2050143009099486D+0 + V=0.4678028558591711D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3370208290706637D+0 + V=0.5538829697598626D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4689051484233963D+0 + V=0.6044475907190476D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5939400424557334D+0 + V=0.6313575103509012D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1394983311832261D+0 + B=0.4097581162050343D-1 + V=0.4078626431855630D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1967999180485014D+0 + B=0.8851987391293348D-1 + V=0.4759933057812725D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2546183732548967D+0 + B=0.1397680182969819D+0 + V=0.5268151186413440D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3121281074713875D+0 + B=0.1929452542226526D+0 + V=0.5643048560507316D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3685981078502492D+0 + B=0.2467898337061562D+0 + V=0.5914501076613073D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4233760321547856D+0 + B=0.3003104124785409D+0 + V=0.6104561257874195D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4758671236059246D+0 + B=0.3526684328175033D+0 + V=0.6230252860707806D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5255178579796463D+0 + B=0.4031134861145713D+0 + V=0.6305618761760796D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5718025633734589D+0 + B=0.4509426448342351D+0 + V=0.6343092767597889D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2686927772723415D+0 + B=0.4711322502423248D-1 + V=0.5176268945737826D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3306006819904809D+0 + B=0.9784487303942695D-1 + V=0.5564840313313692D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3904906850594983D+0 + B=0.1505395810025273D+0 + V=0.5856426671038980D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4479957951904390D+0 + B=0.2039728156296050D+0 + V=0.6066386925777091D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5027076848919780D+0 + B=0.2571529941121107D+0 + V=0.6208824962234458D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5542087392260217D+0 + B=0.3092191375815670D+0 + V=0.6296314297822907D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6020850887375187D+0 + B=0.3593807506130276D+0 + V=0.6340423756791859D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4019851409179594D+0 + B=0.5063389934378671D-1 + V=0.5829627677107342D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4635614567449800D+0 + B=0.1032422269160612D+0 + V=0.6048693376081110D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5215860931591575D+0 + B=0.1566322094006254D+0 + V=0.6202362317732461D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5758202499099271D+0 + B=0.2098082827491099D+0 + V=0.6299005328403779D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6259893683876795D+0 + B=0.2618824114553391D+0 + V=0.6347722390609353D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5313795124811891D+0 + B=0.5263245019338556D-1 + V=0.6203778981238834D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5893317955931995D+0 + B=0.1061059730982005D+0 + V=0.6308414671239979D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6426246321215801D+0 + B=0.1594171564034221D+0 + V=0.6362706466959498D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6511904367376113D+0 + B=0.5354789536565540D-1 + V=0.6375414170333233D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD2030(X,Y,Z,W,N) + DOUBLE PRECISION X(2030) + DOUBLE PRECISION Y(2030) + DOUBLE PRECISION Z(2030) + DOUBLE PRECISION W(2030) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 2030-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.4656031899197431D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.5421549195295507D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2540835336814348D-1 + V=0.1778522133346553D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6399322800504915D-1 + V=0.2811325405682796D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1088269469804125D+0 + V=0.3548896312631459D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1570670798818287D+0 + V=0.4090310897173364D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2071163932282514D+0 + V=0.4493286134169965D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2578914044450844D+0 + V=0.4793728447962723D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3085687558169623D+0 + V=0.5015415319164265D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3584719706267024D+0 + V=0.5175127372677937D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4070135594428709D+0 + V=0.5285522262081019D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4536618626222638D+0 + V=0.5356832703713962D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4979195686463577D+0 + V=0.5397914736175170D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5393075111126999D+0 + V=0.5416899441599930D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6115617676843916D+0 + V=0.5419308476889938D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6414308435160159D+0 + V=0.5416936902030596D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6664099412721607D+0 + V=0.5419544338703164D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6859161771214913D+0 + V=0.5428983656630975D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6993625593503890D+0 + V=0.5442286500098193D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7062393387719380D+0 + V=0.5452250345057301D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7479028168349763D-1 + V=0.2568002497728530D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1848951153969366D+0 + V=0.3827211700292145D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3059529066581305D+0 + V=0.4579491561917824D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4285556101021362D+0 + V=0.5042003969083574D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5468758653496526D+0 + V=0.5312708889976025D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6565821978343439D+0 + V=0.5438401790747117D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1253901572367117D+0 + B=0.3681917226439641D-1 + V=0.3316041873197344D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1775721510383941D+0 + B=0.7982487607213301D-1 + V=0.3899113567153771D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2305693358216114D+0 + B=0.1264640966592335D+0 + V=0.4343343327201309D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2836502845992063D+0 + B=0.1751585683418957D+0 + V=0.4679415262318919D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3361794746232590D+0 + B=0.2247995907632670D+0 + V=0.4930847981631031D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3875979172264824D+0 + B=0.2745299257422246D+0 + V=0.5115031867540091D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4374019316999074D+0 + B=0.3236373482441118D+0 + V=0.5245217148457367D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4851275843340022D+0 + B=0.3714967859436741D+0 + V=0.5332041499895321D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5303391803806868D+0 + B=0.4175353646321745D+0 + V=0.5384583126021542D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5726197380596287D+0 + B=0.4612084406355461D+0 + V=0.5411067210798852D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2431520732564863D+0 + B=0.4258040133043952D-1 + V=0.4259797391468714D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3002096800895869D+0 + B=0.8869424306722721D-1 + V=0.4604931368460021D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3558554457457432D+0 + B=0.1368811706510655D+0 + V=0.4871814878255202D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4097782537048887D+0 + B=0.1860739985015033D+0 + V=0.5072242910074885D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4616337666067458D+0 + B=0.2354235077395853D+0 + V=0.5217069845235350D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5110707008417874D+0 + B=0.2842074921347011D+0 + V=0.5315785966280310D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5577415286163795D+0 + B=0.3317784414984102D+0 + V=0.5376833708758905D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6013060431366950D+0 + B=0.3775299002040700D+0 + V=0.5408032092069521D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3661596767261781D+0 + B=0.4599367887164592D-1 + V=0.4842744917904866D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4237633153506581D+0 + B=0.9404893773654421D-1 + V=0.5048926076188130D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4786328454658452D+0 + B=0.1431377109091971D+0 + V=0.5202607980478373D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5305702076789774D+0 + B=0.1924186388843570D+0 + V=0.5309932388325743D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5793436224231788D+0 + B=0.2411590944775190D+0 + V=0.5377419770895208D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6247069017094747D+0 + B=0.2886871491583605D+0 + V=0.5411696331677717D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4874315552535204D+0 + B=0.4804978774953206D-1 + V=0.5197996293282420D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5427337322059053D+0 + B=0.9716857199366665D-1 + V=0.5311120836622945D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5943493747246700D+0 + B=0.1465205839795055D+0 + V=0.5384309319956951D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6421314033564943D+0 + B=0.1953579449803574D+0 + V=0.5421859504051886D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6020628374713980D+0 + B=0.4916375015738108D-1 + V=0.5390948355046314D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6529222529856881D+0 + B=0.9861621540127005D-1 + V=0.5433312705027845D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD2354(X,Y,Z,W,N) + DOUBLE PRECISION X(2354) + DOUBLE PRECISION Y(2354) + DOUBLE PRECISION Z(2354) + DOUBLE PRECISION W(2354) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 2354-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.3922616270665292D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.4703831750854424D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.4678202801282136D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2290024646530589D-1 + V=0.1437832228979900D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5779086652271284D-1 + V=0.2303572493577644D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9863103576375984D-1 + V=0.2933110752447454D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1428155792982185D+0 + V=0.3402905998359838D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1888978116601463D+0 + V=0.3759138466870372D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2359091682970210D+0 + V=0.4030638447899798D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2831228833706171D+0 + V=0.4236591432242211D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3299495857966693D+0 + V=0.4390522656946746D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3758840802660796D+0 + V=0.4502523466626247D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4204751831009480D+0 + V=0.4580577727783541D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4633068518751051D+0 + V=0.4631391616615899D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5039849474507313D+0 + V=0.4660928953698676D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5421265793440747D+0 + V=0.4674751807936953D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6092660230557310D+0 + V=0.4676414903932920D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6374654204984869D+0 + V=0.4674086492347870D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6615136472609892D+0 + V=0.4674928539483207D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6809487285958127D+0 + V=0.4680748979686447D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6952980021665196D+0 + V=0.4690449806389040D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7041245497695400D+0 + V=0.4699877075860818D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6744033088306065D-1 + V=0.2099942281069176D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1678684485334166D+0 + V=0.3172269150712804D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2793559049539613D+0 + V=0.3832051358546523D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3935264218057639D+0 + V=0.4252193818146985D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5052629268232558D+0 + V=0.4513807963755000D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6107905315437531D+0 + V=0.4657797469114178D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1135081039843524D+0 + B=0.3331954884662588D-1 + V=0.2733362800522836D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1612866626099378D+0 + B=0.7247167465436538D-1 + V=0.3235485368463559D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2100786550168205D+0 + B=0.1151539110849745D+0 + V=0.3624908726013453D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2592282009459942D+0 + B=0.1599491097143677D+0 + V=0.3925540070712828D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3081740561320203D+0 + B=0.2058699956028027D+0 + V=0.4156129781116235D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3564289781578164D+0 + B=0.2521624953502911D+0 + V=0.4330644984623263D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4035587288240703D+0 + B=0.2982090785797674D+0 + V=0.4459677725921312D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4491671196373903D+0 + B=0.3434762087235733D+0 + V=0.4551593004456795D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4928854782917489D+0 + B=0.3874831357203437D+0 + V=0.4613341462749918D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5343646791958988D+0 + B=0.4297814821746926D+0 + V=0.4651019618269806D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5732683216530990D+0 + B=0.4699402260943537D+0 + V=0.4670249536100625D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2214131583218986D+0 + B=0.3873602040643895D-1 + V=0.3549555576441708D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2741796504750071D+0 + B=0.8089496256902013D-1 + V=0.3856108245249010D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3259797439149485D+0 + B=0.1251732177620872D+0 + V=0.4098622845756882D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3765441148826891D+0 + B=0.1706260286403185D+0 + V=0.4286328604268950D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4255773574530558D+0 + B=0.2165115147300408D+0 + V=0.4427802198993945D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4727795117058430D+0 + B=0.2622089812225259D+0 + V=0.4530473511488561D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5178546895819012D+0 + B=0.3071721431296201D+0 + V=0.4600805475703138D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5605141192097460D+0 + B=0.3508998998801138D+0 + V=0.4644599059958017D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6004763319352512D+0 + B=0.3929160876166931D+0 + V=0.4667274455712508D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3352842634946949D+0 + B=0.4202563457288019D-1 + V=0.4069360518020356D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3891971629814670D+0 + B=0.8614309758870850D-1 + V=0.4260442819919195D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4409875565542281D+0 + B=0.1314500879380001D+0 + V=0.4408678508029063D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4904893058592484D+0 + B=0.1772189657383859D+0 + V=0.4518748115548597D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5375056138769549D+0 + B=0.2228277110050294D+0 + V=0.4595564875375116D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5818255708669969D+0 + B=0.2677179935014386D+0 + V=0.4643988774315846D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6232334858144959D+0 + B=0.3113675035544165D+0 + V=0.4668827491646946D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4489485354492058D+0 + B=0.4409162378368174D-1 + V=0.4400541823741973D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5015136875933150D+0 + B=0.8939009917748489D-1 + V=0.4514512890193797D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5511300550512623D+0 + B=0.1351806029383365D+0 + V=0.4596198627347549D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5976720409858000D+0 + B=0.1808370355053196D+0 + V=0.4648659016801781D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6409956378989354D+0 + B=0.2257852192301602D+0 + V=0.4675502017157673D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5581222330827514D+0 + B=0.4532173421637160D-1 + V=0.4598494476455523D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6074705984161695D+0 + B=0.9117488031840314D-1 + V=0.4654916955152048D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6532272537379033D+0 + B=0.1369294213140155D+0 + V=0.4684709779505137D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6594761494500487D+0 + B=0.4589901487275583D-1 + V=0.4691445539106986D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD2702(X,Y,Z,W,N) + DOUBLE PRECISION X(2702) + DOUBLE PRECISION Y(2702) + DOUBLE PRECISION Z(2702) + DOUBLE PRECISION W(2702) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 2702-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.2998675149888161D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.4077860529495355D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2065562538818703D-1 + V=0.1185349192520667D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5250918173022379D-1 + V=0.1913408643425751D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8993480082038376D-1 + V=0.2452886577209897D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1306023924436019D+0 + V=0.2862408183288702D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1732060388531418D+0 + V=0.3178032258257357D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2168727084820249D+0 + V=0.3422945667633690D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2609528309173586D+0 + V=0.3612790520235922D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3049252927938952D+0 + V=0.3758638229818521D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3483484138084404D+0 + V=0.3868711798859953D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3908321549106406D+0 + V=0.3949429933189938D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4320210071894814D+0 + V=0.4006068107541156D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4715824795890053D+0 + V=0.4043192149672723D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5091984794078453D+0 + V=0.4064947495808078D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5445580145650803D+0 + V=0.4075245619813152D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6072575796841768D+0 + V=0.4076423540893566D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6339484505755803D+0 + V=0.4074280862251555D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6570718257486958D+0 + V=0.4074163756012244D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6762557330090709D+0 + V=0.4077647795071246D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6911161696923790D+0 + V=0.4084517552782530D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7012841911659961D+0 + V=0.4092468459224052D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7064559272410020D+0 + V=0.4097872687240906D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6123554989894765D-1 + V=0.1738986811745028D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1533070348312393D+0 + V=0.2659616045280191D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2563902605244206D+0 + V=0.3240596008171533D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3629346991663361D+0 + V=0.3621195964432943D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4683949968987538D+0 + V=0.3868838330760539D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5694479240657952D+0 + V=0.4018911532693111D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6634465430993955D+0 + V=0.4089929432983252D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1033958573552305D+0 + B=0.3034544009063584D-1 + V=0.2279907527706409D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1473521412414395D+0 + B=0.6618803044247135D-1 + V=0.2715205490578897D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1924552158705967D+0 + B=0.1054431128987715D+0 + V=0.3057917896703976D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2381094362890328D+0 + B=0.1468263551238858D+0 + V=0.3326913052452555D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2838121707936760D+0 + B=0.1894486108187886D+0 + V=0.3537334711890037D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3291323133373415D+0 + B=0.2326374238761579D+0 + V=0.3700567500783129D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3736896978741460D+0 + B=0.2758485808485768D+0 + V=0.3825245372589122D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4171406040760013D+0 + B=0.3186179331996921D+0 + V=0.3918125171518296D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4591677985256915D+0 + B=0.3605329796303794D+0 + V=0.3984720419937579D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4994733831718418D+0 + B=0.4012147253586509D+0 + V=0.4029746003338211D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5377731830445096D+0 + B=0.4403050025570692D+0 + V=0.4057428632156627D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5737917830001331D+0 + B=0.4774565904277483D+0 + V=0.4071719274114857D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2027323586271389D+0 + B=0.3544122504976147D-1 + V=0.2990236950664119D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2516942375187273D+0 + B=0.7418304388646328D-1 + V=0.3262951734212878D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3000227995257181D+0 + B=0.1150502745727186D+0 + V=0.3482634608242413D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3474806691046342D+0 + B=0.1571963371209364D+0 + V=0.3656596681700892D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3938103180359209D+0 + B=0.1999631877247100D+0 + V=0.3791740467794218D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4387519590455703D+0 + B=0.2428073457846535D+0 + V=0.3894034450156905D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4820503960077787D+0 + B=0.2852575132906155D+0 + V=0.3968600245508371D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5234573778475101D+0 + B=0.3268884208674639D+0 + V=0.4019931351420050D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5627318647235282D+0 + B=0.3673033321675939D+0 + V=0.4052108801278599D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5996390607156954D+0 + B=0.4061211551830290D+0 + V=0.4068978613940934D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3084780753791947D+0 + B=0.3860125523100059D-1 + V=0.3454275351319704D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3589988275920223D+0 + B=0.7928938987104867D-1 + V=0.3629963537007920D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4078628415881973D+0 + B=0.1212614643030087D+0 + V=0.3770187233889873D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4549287258889735D+0 + B=0.1638770827382693D+0 + V=0.3878608613694378D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5000278512957279D+0 + B=0.2065965798260176D+0 + V=0.3959065270221274D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5429785044928199D+0 + B=0.2489436378852235D+0 + V=0.4015286975463570D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5835939850491711D+0 + B=0.2904811368946891D+0 + V=0.4050866785614717D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6216870353444856D+0 + B=0.3307941957666609D+0 + V=0.4069320185051913D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4151104662709091D+0 + B=0.4064829146052554D-1 + V=0.3760120964062763D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4649804275009218D+0 + B=0.8258424547294755D-1 + V=0.3870969564418064D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5124695757009662D+0 + B=0.1251841962027289D+0 + V=0.3955287790534055D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5574711100606224D+0 + B=0.1679107505976331D+0 + V=0.4015361911302668D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5998597333287227D+0 + B=0.2102805057358715D+0 + V=0.4053836986719548D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6395007148516600D+0 + B=0.2518418087774107D+0 + V=0.4073578673299117D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5188456224746252D+0 + B=0.4194321676077518D-1 + V=0.3954628379231406D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5664190707942778D+0 + B=0.8457661551921499D-1 + V=0.4017645508847530D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6110464353283153D+0 + B=0.1273652932519396D+0 + V=0.4059030348651293D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6526430302051563D+0 + B=0.1698173239076354D+0 + V=0.4080565809484880D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6167551880377548D+0 + B=0.4266398851548864D-1 + V=0.4063018753664651D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6607195418355383D+0 + B=0.8551925814238349D-1 + V=0.4087191292799671D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD3074(X,Y,Z,W,N) + DOUBLE PRECISION X(3074) + DOUBLE PRECISION Y(3074) + DOUBLE PRECISION Z(3074) + DOUBLE PRECISION W(3074) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 3074-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.2599095953754734D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3603134089687541D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3586067974412447D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1886108518723392D-1 + V=0.9831528474385880D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4800217244625303D-1 + V=0.1605023107954450D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8244922058397242D-1 + V=0.2072200131464099D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1200408362484023D+0 + V=0.2431297618814187D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1595773530809965D+0 + V=0.2711819064496707D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2002635973434064D+0 + V=0.2932762038321116D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2415127590139982D+0 + V=0.3107032514197368D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2828584158458477D+0 + V=0.3243808058921213D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3239091015338138D+0 + V=0.3349899091374030D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3643225097962194D+0 + V=0.3430580688505218D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4037897083691802D+0 + V=0.3490124109290343D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4420247515194127D+0 + V=0.3532148948561955D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4787572538464938D+0 + V=0.3559862669062833D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5137265251275234D+0 + V=0.3576224317551411D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5466764056654611D+0 + V=0.3584050533086076D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6054859420813535D+0 + V=0.3584903581373224D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6308106701764562D+0 + V=0.3582991879040586D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6530369230179584D+0 + V=0.3582371187963125D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6718609524611158D+0 + V=0.3584353631122350D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6869676499894013D+0 + V=0.3589120166517785D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6980467077240748D+0 + V=0.3595445704531601D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7048241721250522D+0 + V=0.3600943557111074D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5591105222058232D-1 + V=0.1456447096742039D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1407384078513916D+0 + V=0.2252370188283782D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2364035438976309D+0 + V=0.2766135443474897D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3360602737818170D+0 + V=0.3110729491500851D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4356292630054665D+0 + V=0.3342506712303391D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5321569415256174D+0 + V=0.3491981834026860D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6232956305040554D+0 + V=0.3576003604348932D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9469870086838469D-1 + B=0.2778748387309470D-1 + V=0.1921921305788564D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1353170300568141D+0 + B=0.6076569878628364D-1 + V=0.2301458216495632D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1771679481726077D+0 + B=0.9703072762711040D-1 + V=0.2604248549522893D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2197066664231751D+0 + B=0.1354112458524762D+0 + V=0.2845275425870697D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2624783557374927D+0 + B=0.1750996479744100D+0 + V=0.3036870897974840D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3050969521214442D+0 + B=0.2154896907449802D+0 + V=0.3188414832298066D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3472252637196021D+0 + B=0.2560954625740152D+0 + V=0.3307046414722089D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3885610219026360D+0 + B=0.2965070050624096D+0 + V=0.3398330969031360D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4288273776062765D+0 + B=0.3363641488734497D+0 + V=0.3466757899705373D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4677662471302948D+0 + B=0.3753400029836788D+0 + V=0.3516095923230054D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5051333589553359D+0 + B=0.4131297522144286D+0 + V=0.3549645184048486D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5406942145810492D+0 + B=0.4494423776081795D+0 + V=0.3570415969441392D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5742204122576457D+0 + B=0.4839938958841502D+0 + V=0.3581251798496118D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1865407027225188D+0 + B=0.3259144851070796D-1 + V=0.2543491329913348D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2321186453689432D+0 + B=0.6835679505297343D-1 + V=0.2786711051330776D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2773159142523882D+0 + B=0.1062284864451989D+0 + V=0.2985552361083679D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3219200192237254D+0 + B=0.1454404409323047D+0 + V=0.3145867929154039D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3657032593944029D+0 + B=0.1854018282582510D+0 + V=0.3273290662067609D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4084376778363622D+0 + B=0.2256297412014750D+0 + V=0.3372705511943501D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4499004945751427D+0 + B=0.2657104425000896D+0 + V=0.3448274437851510D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4898758141326335D+0 + B=0.3052755487631557D+0 + V=0.3503592783048583D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5281547442266309D+0 + B=0.3439863920645423D+0 + V=0.3541854792663162D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5645346989813992D+0 + B=0.3815229456121914D+0 + V=0.3565995517909428D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5988181252159848D+0 + B=0.4175752420966734D+0 + V=0.3578802078302898D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2850425424471603D+0 + B=0.3562149509862536D-1 + V=0.2958644592860982D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3324619433027876D+0 + B=0.7330318886871096D-1 + V=0.3119548129116835D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3785848333076282D+0 + B=0.1123226296008472D+0 + V=0.3250745225005984D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4232891028562115D+0 + B=0.1521084193337708D+0 + V=0.3355153415935208D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4664287050829722D+0 + B=0.1921844459223610D+0 + V=0.3435847568549328D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5078458493735726D+0 + B=0.2321360989678303D+0 + V=0.3495786831622488D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5473779816204180D+0 + B=0.2715886486360520D+0 + V=0.3537767805534621D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5848617133811376D+0 + B=0.3101924707571355D+0 + V=0.3564459815421428D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6201348281584888D+0 + B=0.3476121052890973D+0 + V=0.3578464061225468D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3852191185387871D+0 + B=0.3763224880035108D-1 + V=0.3239748762836212D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4325025061073423D+0 + B=0.7659581935637135D-1 + V=0.3345491784174287D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4778486229734490D+0 + B=0.1163381306083900D+0 + V=0.3429126177301782D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5211663693009000D+0 + B=0.1563890598752899D+0 + V=0.3492420343097421D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5623469504853703D+0 + B=0.1963320810149200D+0 + V=0.3537399050235257D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6012718188659246D+0 + B=0.2357847407258738D+0 + V=0.3566209152659172D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6378179206390117D+0 + B=0.2743846121244060D+0 + V=0.3581084321919782D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4836936460214534D+0 + B=0.3895902610739024D-1 + V=0.3426522117591512D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5293792562683797D+0 + B=0.7871246819312640D-1 + V=0.3491848770121379D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5726281253100033D+0 + B=0.1187963808202981D+0 + V=0.3539318235231476D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6133658776169068D+0 + B=0.1587914708061787D+0 + V=0.3570231438458694D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6515085491865307D+0 + B=0.1983058575227646D+0 + V=0.3586207335051714D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5778692716064976D+0 + B=0.3977209689791542D-1 + V=0.3541196205164025D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6207904288086192D+0 + B=0.7990157592981152D-1 + V=0.3574296911573953D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6608688171046802D+0 + B=0.1199671308754309D+0 + V=0.3591993279818963D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6656263089489130D+0 + B=0.4015955957805969D-1 + V=0.3595855034661997D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD3470(X,Y,Z,W,N) + DOUBLE PRECISION X(3470) + DOUBLE PRECISION Y(3470) + DOUBLE PRECISION Z(3470) + DOUBLE PRECISION W(3470) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 3470-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.2040382730826330D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.3178149703889544D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1721420832906233D-1 + V=0.8288115128076110D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4408875374981770D-1 + V=0.1360883192522954D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7594680813878681D-1 + V=0.1766854454542662D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1108335359204799D+0 + V=0.2083153161230153D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1476517054388567D+0 + V=0.2333279544657158D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1856731870860615D+0 + V=0.2532809539930247D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2243634099428821D+0 + V=0.2692472184211158D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2633006881662727D+0 + V=0.2819949946811885D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3021340904916283D+0 + V=0.2920953593973030D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3405594048030089D+0 + V=0.2999889782948352D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3783044434007372D+0 + V=0.3060292120496902D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4151194767407910D+0 + V=0.3105109167522192D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4507705766443257D+0 + V=0.3136902387550312D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4850346056573187D+0 + V=0.3157984652454632D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5176950817792470D+0 + V=0.3170516518425422D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5485384240820989D+0 + V=0.3176568425633755D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6039117238943308D+0 + V=0.3177198411207062D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6279956655573113D+0 + V=0.3175519492394733D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6493636169568952D+0 + V=0.3174654952634756D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6677644117704504D+0 + V=0.3175676415467654D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6829368572115624D+0 + V=0.3178923417835410D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6946195818184121D+0 + V=0.3183788287531909D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7025711542057026D+0 + V=0.3188755151918807D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7066004767140119D+0 + V=0.3191916889313849D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5132537689946062D-1 + V=0.1231779611744508D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1297994661331225D+0 + V=0.1924661373839880D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2188852049401307D+0 + V=0.2380881867403424D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3123174824903457D+0 + V=0.2693100663037885D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4064037620738195D+0 + V=0.2908673382834366D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4984958396944782D+0 + V=0.3053914619381535D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5864975046021365D+0 + V=0.3143916684147777D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6686711634580175D+0 + V=0.3187042244055363D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8715738780835950D-1 + B=0.2557175233367578D-1 + V=0.1635219535869790D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1248383123134007D+0 + B=0.5604823383376681D-1 + V=0.1968109917696070D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1638062693383378D+0 + B=0.8968568601900765D-1 + V=0.2236754342249974D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2035586203373176D+0 + B=0.1254086651976279D+0 + V=0.2453186687017181D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2436798975293774D+0 + B=0.1624780150162012D+0 + V=0.2627551791580541D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2838207507773806D+0 + B=0.2003422342683208D+0 + V=0.2767654860152220D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3236787502217692D+0 + B=0.2385628026255263D+0 + V=0.2879467027765895D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3629849554840691D+0 + B=0.2767731148783578D+0 + V=0.2967639918918702D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4014948081992087D+0 + B=0.3146542308245309D+0 + V=0.3035900684660351D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4389818379260225D+0 + B=0.3519196415895088D+0 + V=0.3087338237298308D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4752331143674377D+0 + B=0.3883050984023654D+0 + V=0.3124608838860167D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5100457318374018D+0 + B=0.4235613423908649D+0 + V=0.3150084294226743D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5432238388954868D+0 + B=0.4574484717196220D+0 + V=0.3165958398598402D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5745758685072442D+0 + B=0.4897311639255524D+0 + V=0.3174320440957372D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1723981437592809D+0 + B=0.3010630597881105D-1 + V=0.2182188909812599D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2149553257844597D+0 + B=0.6326031554204694D-1 + V=0.2399727933921445D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2573256081247422D+0 + B=0.9848566980258631D-1 + V=0.2579796133514652D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2993163751238106D+0 + B=0.1350835952384266D+0 + V=0.2727114052623535D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3407238005148000D+0 + B=0.1725184055442181D+0 + V=0.2846327656281355D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3813454978483264D+0 + B=0.2103559279730725D+0 + V=0.2941491102051334D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4209848104423343D+0 + B=0.2482278774554860D+0 + V=0.3016049492136107D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4594519699996300D+0 + B=0.2858099509982883D+0 + V=0.3072949726175648D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4965640166185930D+0 + B=0.3228075659915428D+0 + V=0.3114768142886460D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5321441655571562D+0 + B=0.3589459907204151D+0 + V=0.3143823673666223D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5660208438582166D+0 + B=0.3939630088864310D+0 + V=0.3162269764661535D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5980264315964364D+0 + B=0.4276029922949089D+0 + V=0.3172164663759821D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2644215852350733D+0 + B=0.3300939429072552D-1 + V=0.2554575398967435D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3090113743443063D+0 + B=0.6803887650078501D-1 + V=0.2701704069135677D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3525871079197808D+0 + B=0.1044326136206709D+0 + V=0.2823693413468940D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3950418005354029D+0 + B=0.1416751597517679D+0 + V=0.2922898463214289D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4362475663430163D+0 + B=0.1793408610504821D+0 + V=0.3001829062162428D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4760661812145854D+0 + B=0.2170630750175722D+0 + V=0.3062890864542953D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5143551042512103D+0 + B=0.2545145157815807D+0 + V=0.3108328279264746D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5509709026935597D+0 + B=0.2913940101706601D+0 + V=0.3140243146201245D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5857711030329428D+0 + B=0.3274169910910705D+0 + V=0.3160638030977130D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6186149917404392D+0 + B=0.3623081329317265D+0 + V=0.3171462882206275D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3586894569557064D+0 + B=0.3497354386450040D-1 + V=0.2812388416031796D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4035266610019441D+0 + B=0.7129736739757095D-1 + V=0.2912137500288045D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4467775312332510D+0 + B=0.1084758620193165D+0 + V=0.2993241256502206D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4883638346608543D+0 + B=0.1460915689241772D+0 + V=0.3057101738983822D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5281908348434601D+0 + B=0.1837790832369980D+0 + V=0.3105319326251432D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5661542687149311D+0 + B=0.2212075390874021D+0 + V=0.3139565514428167D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6021450102031452D+0 + B=0.2580682841160985D+0 + V=0.3161543006806366D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6360520783610050D+0 + B=0.2940656362094121D+0 + V=0.3172985960613294D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4521611065087196D+0 + B=0.3631055365867002D-1 + V=0.2989400336901431D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4959365651560963D+0 + B=0.7348318468484350D-1 + V=0.3054555883947677D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5376815804038283D+0 + B=0.1111087643812648D+0 + V=0.3104764960807702D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5773314480243768D+0 + B=0.1488226085145408D+0 + V=0.3141015825977616D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6148113245575056D+0 + B=0.1862892274135151D+0 + V=0.3164520621159896D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6500407462842380D+0 + B=0.2231909701714456D+0 + V=0.3176652305912204D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5425151448707213D+0 + B=0.3718201306118944D-1 + V=0.3105097161023939D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5841860556907931D+0 + B=0.7483616335067346D-1 + V=0.3143014117890550D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6234632186851500D+0 + B=0.1125990834266120D+0 + V=0.3168172866287200D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6602934551848843D+0 + B=0.1501303813157619D+0 + V=0.3181401865570968D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6278573968375105D+0 + B=0.3767559930245720D-1 + V=0.3170663659156037D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6665611711264577D+0 + B=0.7548443301360158D-1 + V=0.3185447944625510D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD3890(X,Y,Z,W,N) + DOUBLE PRECISION X(3890) + DOUBLE PRECISION Y(3890) + DOUBLE PRECISION Z(3890) + DOUBLE PRECISION W(3890) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 3890-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1807395252196920D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2848008782238827D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2836065837530581D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1587876419858352D-1 + V=0.7013149266673816D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4069193593751206D-1 + V=0.1162798021956766D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7025888115257997D-1 + V=0.1518728583972105D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1027495450028704D+0 + V=0.1798796108216934D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1371457730893426D+0 + V=0.2022593385972785D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1727758532671953D+0 + V=0.2203093105575464D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2091492038929037D+0 + V=0.2349294234299855D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2458813281751915D+0 + V=0.2467682058747003D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2826545859450066D+0 + V=0.2563092683572224D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3191957291799622D+0 + V=0.2639253896763318D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3552621469299578D+0 + V=0.2699137479265108D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3906329503406230D+0 + V=0.2745196420166739D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4251028614093031D+0 + V=0.2779529197397593D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4584777520111870D+0 + V=0.2803996086684265D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4905711358710193D+0 + V=0.2820302356715842D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5212011669847385D+0 + V=0.2830056747491068D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5501878488737995D+0 + V=0.2834808950776839D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6025037877479342D+0 + V=0.2835282339078929D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6254572689549016D+0 + V=0.2833819267065800D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6460107179528248D+0 + V=0.2832858336906784D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6639541138154251D+0 + V=0.2833268235451244D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6790688515667495D+0 + V=0.2835432677029253D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6911338580371512D+0 + V=0.2839091722743049D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6999385956126490D+0 + V=0.2843308178875841D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7053037748656896D+0 + V=0.2846703550533846D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4732224387180115D-1 + V=0.1051193406971900D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1202100529326803D+0 + V=0.1657871838796974D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2034304820664855D+0 + V=0.2064648113714232D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2912285643573002D+0 + V=0.2347942745819741D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3802361792726768D+0 + V=0.2547775326597726D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4680598511056146D+0 + V=0.2686876684847025D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5528151052155599D+0 + V=0.2778665755515867D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6329386307803041D+0 + V=0.2830996616782929D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8056516651369069D-1 + B=0.2363454684003124D-1 + V=0.1403063340168372D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1156476077139389D+0 + B=0.5191291632545936D-1 + V=0.1696504125939477D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1520473382760421D+0 + B=0.8322715736994519D-1 + V=0.1935787242745390D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1892986699745931D+0 + B=0.1165855667993712D+0 + V=0.2130614510521968D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2270194446777792D+0 + B=0.1513077167409504D+0 + V=0.2289381265931048D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2648908185093273D+0 + B=0.1868882025807859D+0 + V=0.2418630292816186D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3026389259574136D+0 + B=0.2229277629776224D+0 + V=0.2523400495631193D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3400220296151384D+0 + B=0.2590951840746235D+0 + V=0.2607623973449605D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3768217953335510D+0 + B=0.2951047291750847D+0 + V=0.2674441032689209D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4128372900921884D+0 + B=0.3307019714169930D+0 + V=0.2726432360343356D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4478807131815630D+0 + B=0.3656544101087634D+0 + V=0.2765787685924545D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4817742034089257D+0 + B=0.3997448951939695D+0 + V=0.2794428690642224D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5143472814653344D+0 + B=0.4327667110812024D+0 + V=0.2814099002062895D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5454346213905650D+0 + B=0.4645196123532293D+0 + V=0.2826429531578994D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5748739313170252D+0 + B=0.4948063555703345D+0 + V=0.2832983542550884D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1599598738286342D+0 + B=0.2792357590048985D-1 + V=0.1886695565284976D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1998097412500951D+0 + B=0.5877141038139065D-1 + V=0.2081867882748234D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2396228952566202D+0 + B=0.9164573914691377D-1 + V=0.2245148680600796D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2792228341097746D+0 + B=0.1259049641962687D+0 + V=0.2380370491511872D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3184251107546741D+0 + B=0.1610594823400863D+0 + V=0.2491398041852455D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3570481164426244D+0 + B=0.1967151653460898D+0 + V=0.2581632405881230D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3949164710492144D+0 + B=0.2325404606175168D+0 + V=0.2653965506227417D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4318617293970503D+0 + B=0.2682461141151439D+0 + V=0.2710857216747087D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4677221009931678D+0 + B=0.3035720116011973D+0 + V=0.2754434093903659D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5023417939270955D+0 + B=0.3382781859197439D+0 + V=0.2786579932519380D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5355701836636128D+0 + B=0.3721383065625942D+0 + V=0.2809011080679474D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5672608451328771D+0 + B=0.4049346360466055D+0 + V=0.2823336184560987D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5972704202540162D+0 + B=0.4364538098633802D+0 + V=0.2831101175806309D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2461687022333596D+0 + B=0.3070423166833368D-1 + V=0.2221679970354546D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2881774566286831D+0 + B=0.6338034669281885D-1 + V=0.2356185734270703D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3293963604116978D+0 + B=0.9742862487067941D-1 + V=0.2469228344805590D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3697303822241377D+0 + B=0.1323799532282290D+0 + V=0.2562726348642046D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4090663023135127D+0 + B=0.1678497018129336D+0 + V=0.2638756726753028D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4472819355411712D+0 + B=0.2035095105326114D+0 + V=0.2699311157390862D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4842513377231437D+0 + B=0.2390692566672091D+0 + V=0.2746233268403837D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5198477629962928D+0 + B=0.2742649818076149D+0 + V=0.2781225674454771D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5539453011883145D+0 + B=0.3088503806580094D+0 + V=0.2805881254045684D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5864196762401251D+0 + B=0.3425904245906614D+0 + V=0.2821719877004913D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6171484466668390D+0 + B=0.3752562294789468D+0 + V=0.2830222502333124D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3350337830565727D+0 + B=0.3261589934634747D-1 + V=0.2457995956744870D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3775773224758284D+0 + B=0.6658438928081572D-1 + V=0.2551474407503706D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4188155229848973D+0 + B=0.1014565797157954D+0 + V=0.2629065335195311D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4586805892009344D+0 + B=0.1368573320843822D+0 + V=0.2691900449925075D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4970895714224235D+0 + B=0.1724614851951608D+0 + V=0.2741275485754276D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5339505133960747D+0 + B=0.2079779381416412D+0 + V=0.2778530970122595D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5691665792531440D+0 + B=0.2431385788322288D+0 + V=0.2805010567646741D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6026387682680377D+0 + B=0.2776901883049853D+0 + V=0.2822055834031040D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6342676150163307D+0 + B=0.3113881356386632D+0 + V=0.2831016901243473D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4237951119537067D+0 + B=0.3394877848664351D-1 + V=0.2624474901131803D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4656918683234929D+0 + B=0.6880219556291447D-1 + V=0.2688034163039377D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5058857069185980D+0 + B=0.1041946859721635D+0 + V=0.2738932751287636D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5443204666713996D+0 + B=0.1398039738736393D+0 + V=0.2777944791242523D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5809298813759742D+0 + B=0.1753373381196155D+0 + V=0.2806011661660987D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6156416039447128D+0 + B=0.2105215793514010D+0 + V=0.2824181456597460D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6483801351066604D+0 + B=0.2450953312157051D+0 + V=0.2833585216577828D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5103616577251688D+0 + B=0.3485560643800719D-1 + V=0.2738165236962878D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5506738792580681D+0 + B=0.7026308631512033D-1 + V=0.2778365208203180D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5889573040995292D+0 + B=0.1059035061296403D+0 + V=0.2807852940418966D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6251641589516930D+0 + B=0.1414823925236026D+0 + V=0.2827245949674705D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6592414921570178D+0 + B=0.1767207908214530D+0 + V=0.2837342344829828D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5930314017533384D+0 + B=0.3542189339561672D-1 + V=0.2809233907610981D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6309812253390175D+0 + B=0.7109574040369549D-1 + V=0.2829930809742694D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6666296011353230D+0 + B=0.1067259792282730D+0 + V=0.2841097874111479D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6703715271049922D+0 + B=0.3569455268820809D-1 + V=0.2843455206008783D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD4334(X,Y,Z,W,N) + DOUBLE PRECISION X(4334) + DOUBLE PRECISION Y(4334) + DOUBLE PRECISION Z(4334) + DOUBLE PRECISION W(4334) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 4334-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.1449063022537883D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2546377329828424D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1462896151831013D-1 + V=0.6018432961087496D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3769840812493139D-1 + V=0.1002286583263673D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6524701904096891D-1 + V=0.1315222931028093D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9560543416134648D-1 + V=0.1564213746876724D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1278335898929198D+0 + V=0.1765118841507736D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1613096104466031D+0 + V=0.1928737099311080D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1955806225745371D+0 + V=0.2062658534263270D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2302935218498028D+0 + V=0.2172395445953787D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2651584344113027D+0 + V=0.2262076188876047D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2999276825183209D+0 + V=0.2334885699462397D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3343828669718798D+0 + V=0.2393355273179203D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3683265013750518D+0 + V=0.2439559200468863D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4015763206518108D+0 + V=0.2475251866060002D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4339612026399770D+0 + V=0.2501965558158773D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4653180651114582D+0 + V=0.2521081407925925D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4954893331080803D+0 + V=0.2533881002388081D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5243207068924930D+0 + V=0.2541582900848261D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5516590479041704D+0 + V=0.2545365737525860D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6012371927804176D+0 + V=0.2545726993066799D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6231574466449819D+0 + V=0.2544456197465555D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6429416514181271D+0 + V=0.2543481596881064D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6604124272943595D+0 + V=0.2543506451429194D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6753851470408250D+0 + V=0.2544905675493763D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6876717970626160D+0 + V=0.2547611407344429D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6970895061319234D+0 + V=0.2551060375448869D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7034746912553310D+0 + V=0.2554291933816039D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7067017217542295D+0 + V=0.2556255710686343D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4382223501131123D-1 + V=0.9041339695118195D-4 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1117474077400006D+0 + V=0.1438426330079022D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1897153252911440D+0 + V=0.1802523089820518D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2724023009910331D+0 + V=0.2060052290565496D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3567163308709902D+0 + V=0.2245002248967466D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4404784483028087D+0 + V=0.2377059847731150D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5219833154161411D+0 + V=0.2468118955882525D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5998179868977553D+0 + V=0.2525410872966528D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6727803154548222D+0 + V=0.2553101409933397D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7476563943166086D-1 + B=0.2193168509461185D-1 + V=0.1212879733668632D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1075341482001416D+0 + B=0.4826419281533887D-1 + V=0.1472872881270931D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1416344885203259D+0 + B=0.7751191883575742D-1 + V=0.1686846601010828D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1766325315388586D+0 + B=0.1087558139247680D+0 + V=0.1862698414660208D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2121744174481514D+0 + B=0.1413661374253096D+0 + V=0.2007430956991861D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2479669443408145D+0 + B=0.1748768214258880D+0 + V=0.2126568125394796D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2837600452294113D+0 + B=0.2089216406612073D+0 + V=0.2224394603372113D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3193344933193984D+0 + B=0.2431987685545972D+0 + V=0.2304264522673135D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3544935442438745D+0 + B=0.2774497054377770D+0 + V=0.2368854288424087D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3890571932288154D+0 + B=0.3114460356156915D+0 + V=0.2420352089461772D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4228581214259090D+0 + B=0.3449806851913012D+0 + V=0.2460597113081295D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4557387211304052D+0 + B=0.3778618641248256D+0 + V=0.2491181912257687D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4875487950541643D+0 + B=0.4099086391698978D+0 + V=0.2513528194205857D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5181436529962997D+0 + B=0.4409474925853973D+0 + V=0.2528943096693220D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5473824095600661D+0 + B=0.4708094517711291D+0 + V=0.2538660368488136D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5751263398976174D+0 + B=0.4993275140354637D+0 + V=0.2543868648299022D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1489515746840028D+0 + B=0.2599381993267017D-1 + V=0.1642595537825183D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1863656444351767D+0 + B=0.5479286532462190D-1 + V=0.1818246659849308D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2238602880356348D+0 + B=0.8556763251425254D-1 + V=0.1966565649492420D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2612723375728160D+0 + B=0.1177257802267011D+0 + V=0.2090677905657991D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2984332990206190D+0 + B=0.1508168456192700D+0 + V=0.2193820409510504D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3351786584663333D+0 + B=0.1844801892177727D+0 + V=0.2278870827661928D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3713505522209120D+0 + B=0.2184145236087598D+0 + V=0.2348283192282090D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4067981098954663D+0 + B=0.2523590641486229D+0 + V=0.2404139755581477D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4413769993687534D+0 + B=0.2860812976901373D+0 + V=0.2448227407760734D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4749487182516394D+0 + B=0.3193686757808996D+0 + V=0.2482110455592573D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5073798105075426D+0 + B=0.3520226949547602D+0 + V=0.2507192397774103D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5385410448878654D+0 + B=0.3838544395667890D+0 + V=0.2524765968534880D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5683065353670530D+0 + B=0.4146810037640963D+0 + V=0.2536052388539425D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5965527620663510D+0 + B=0.4443224094681121D+0 + V=0.2542230588033068D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2299227700856157D+0 + B=0.2865757664057584D-1 + V=0.1944817013047896D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2695752998553267D+0 + B=0.5923421684485993D-1 + V=0.2067862362746635D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3086178716611389D+0 + B=0.9117817776057715D-1 + V=0.2172440734649114D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3469649871659077D+0 + B=0.1240593814082605D+0 + V=0.2260125991723423D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3845153566319655D+0 + B=0.1575272058259175D+0 + V=0.2332655008689523D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4211600033403215D+0 + B=0.1912845163525413D+0 + V=0.2391699681532458D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4567867834329882D+0 + B=0.2250710177858171D+0 + V=0.2438801528273928D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4912829319232061D+0 + B=0.2586521303440910D+0 + V=0.2475370504260665D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5245364793303812D+0 + B=0.2918112242865407D+0 + V=0.2502707235640574D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5564369788915756D+0 + B=0.3243439239067890D+0 + V=0.2522031701054241D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5868757697775287D+0 + B=0.3560536787835351D+0 + V=0.2534511269978784D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6157458853519617D+0 + B=0.3867480821242581D+0 + V=0.2541284914955151D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3138461110672113D+0 + B=0.3051374637507278D-1 + V=0.2161509250688394D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3542495872050569D+0 + B=0.6237111233730755D-1 + V=0.2248778513437852D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3935751553120181D+0 + B=0.9516223952401907D-1 + V=0.2322388803404617D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4317634668111147D+0 + B=0.1285467341508517D+0 + V=0.2383265471001355D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4687413842250821D+0 + B=0.1622318931656033D+0 + V=0.2432476675019525D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5044274237060283D+0 + B=0.1959581153836453D+0 + V=0.2471122223750674D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5387354077925727D+0 + B=0.2294888081183837D+0 + V=0.2500291752486870D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5715768898356105D+0 + B=0.2626031152713945D+0 + V=0.2521055942764682D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6028627200136111D+0 + B=0.2950904075286713D+0 + V=0.2534472785575503D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6325039812653463D+0 + B=0.3267458451113286D+0 + V=0.2541599713080121D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3981986708423407D+0 + B=0.3183291458749821D-1 + V=0.2317380975862936D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4382791182133300D+0 + B=0.6459548193880908D-1 + V=0.2378550733719775D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4769233057218166D+0 + B=0.9795757037087952D-1 + V=0.2428884456739118D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5140823911194238D+0 + B=0.1316307235126655D+0 + V=0.2469002655757292D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5496977833862983D+0 + B=0.1653556486358704D+0 + V=0.2499657574265851D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5837047306512727D+0 + B=0.1988931724126510D+0 + V=0.2521676168486082D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6160349566926879D+0 + B=0.2320174581438950D+0 + V=0.2535935662645334D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6466185353209440D+0 + B=0.2645106562168662D+0 + V=0.2543356743363214D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4810835158795404D+0 + B=0.3275917807743992D-1 + V=0.2427353285201535D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5199925041324341D+0 + B=0.6612546183967181D-1 + V=0.2468258039744386D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5571717692207494D+0 + B=0.9981498331474143D-1 + V=0.2500060956440310D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5925789250836378D+0 + B=0.1335687001410374D+0 + V=0.2523238365420979D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6261658523859670D+0 + B=0.1671444402896463D+0 + V=0.2538399260252846D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6578811126669331D+0 + B=0.2003106382156076D+0 + V=0.2546255927268069D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5609624612998100D+0 + B=0.3337500940231335D-1 + V=0.2500583360048449D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5979959659984670D+0 + B=0.6708750335901803D-1 + V=0.2524777638260203D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6330523711054002D+0 + B=0.1008792126424850D+0 + V=0.2540951193860656D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6660960998103972D+0 + B=0.1345050343171794D+0 + V=0.2549524085027472D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6365384364585819D+0 + B=0.3372799460737052D-1 + V=0.2542569507009158D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6710994302899275D+0 + B=0.6755249309678028D-1 + V=0.2552114127580376D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD4802(X,Y,Z,W,N) + DOUBLE PRECISION X(4802) + DOUBLE PRECISION Y(4802) + DOUBLE PRECISION Z(4802) + DOUBLE PRECISION W(4802) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 4802-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.9687521879420705D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2307897895367918D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2297310852498558D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2335728608887064D-1 + V=0.7386265944001919D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4352987836550653D-1 + V=0.8257977698542210D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6439200521088801D-1 + V=0.9706044762057630D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9003943631993181D-1 + V=0.1302393847117003D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1196706615548473D+0 + V=0.1541957004600968D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1511715412838134D+0 + V=0.1704459770092199D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1835982828503801D+0 + V=0.1827374890942906D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2165081259155405D+0 + V=0.1926360817436107D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2496208720417563D+0 + V=0.2008010239494833D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2827200673567900D+0 + V=0.2075635983209175D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3156190823994346D+0 + V=0.2131306638690909D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3481476793749115D+0 + V=0.2176562329937335D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3801466086947226D+0 + V=0.2212682262991018D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4114652119634011D+0 + V=0.2240799515668565D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4419598786519751D+0 + V=0.2261959816187525D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4714925949329543D+0 + V=0.2277156368808855D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4999293972879466D+0 + V=0.2287351772128336D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5271387221431248D+0 + V=0.2293490814084085D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5529896780837761D+0 + V=0.2296505312376273D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6000856099481712D+0 + V=0.2296793832318756D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6210562192785175D+0 + V=0.2295785443842974D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6401165879934240D+0 + V=0.2295017931529102D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6571144029244334D+0 + V=0.2295059638184868D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6718910821718863D+0 + V=0.2296232343237362D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6842845591099010D+0 + V=0.2298530178740771D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6941353476269816D+0 + V=0.2301579790280501D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7012965242212991D+0 + V=0.2304690404996513D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7056471428242644D+0 + V=0.2307027995907102D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4595557643585895D-1 + V=0.9312274696671092D-4 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1049316742435023D+0 + V=0.1199919385876926D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1773548879549274D+0 + V=0.1598039138877690D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2559071411236127D+0 + V=0.1822253763574900D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3358156837985898D+0 + V=0.1988579593655040D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4155835743763893D+0 + V=0.2112620102533307D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4937894296167472D+0 + V=0.2201594887699007D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5691569694793316D+0 + V=0.2261622590895036D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6405840854894251D+0 + V=0.2296458453435705D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7345133894143348D-1 + B=0.2177844081486067D-1 + V=0.1006006990267000D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1009859834044931D+0 + B=0.4590362185775188D-1 + V=0.1227676689635876D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1324289619748758D+0 + B=0.7255063095690877D-1 + V=0.1467864280270117D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1654272109607127D+0 + B=0.1017825451960684D+0 + V=0.1644178912101232D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1990767186776461D+0 + B=0.1325652320980364D+0 + V=0.1777664890718961D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2330125945523278D+0 + B=0.1642765374496765D+0 + V=0.1884825664516690D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2670080611108287D+0 + B=0.1965360374337889D+0 + V=0.1973269246453848D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3008753376294316D+0 + B=0.2290726770542238D+0 + V=0.2046767775855328D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3344475596167860D+0 + B=0.2616645495370823D+0 + V=0.2107600125918040D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3675709724070786D+0 + B=0.2941150728843141D+0 + V=0.2157416362266829D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4001000887587812D+0 + B=0.3262440400919066D+0 + V=0.2197557816920721D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4318956350436028D+0 + B=0.3578835350611916D+0 + V=0.2229192611835437D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4628239056795531D+0 + B=0.3888751854043678D+0 + V=0.2253385110212775D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4927563229773636D+0 + B=0.4190678003222840D+0 + V=0.2271137107548774D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5215687136707969D+0 + B=0.4483151836883852D+0 + V=0.2283414092917525D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5491402346984905D+0 + B=0.4764740676087880D+0 + V=0.2291161673130077D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5753520160126075D+0 + B=0.5034021310998277D+0 + V=0.2295313908576598D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1388326356417754D+0 + B=0.2435436510372806D-1 + V=0.1438204721359031D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1743686900537244D+0 + B=0.5118897057342652D-1 + V=0.1607738025495257D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2099737037950268D+0 + B=0.8014695048539634D-1 + V=0.1741483853528379D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2454492590908548D+0 + B=0.1105117874155699D+0 + V=0.1851918467519151D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2807219257864278D+0 + B=0.1417950531570966D+0 + V=0.1944628638070613D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3156842271975842D+0 + B=0.1736604945719597D+0 + V=0.2022495446275152D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3502090945177752D+0 + B=0.2058466324693981D+0 + V=0.2087462382438514D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3841684849519686D+0 + B=0.2381284261195919D+0 + V=0.2141074754818308D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4174372367906016D+0 + B=0.2703031270422569D+0 + V=0.2184640913748162D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4498926465011892D+0 + B=0.3021845683091309D+0 + V=0.2219309165220329D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4814146229807701D+0 + B=0.3335993355165720D+0 + V=0.2246123118340624D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5118863625734701D+0 + B=0.3643833735518232D+0 + V=0.2266062766915125D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5411947455119144D+0 + B=0.3943789541958179D+0 + V=0.2280072952230796D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5692301500357246D+0 + B=0.4234320144403542D+0 + V=0.2289082025202583D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5958857204139576D+0 + B=0.4513897947419260D+0 + V=0.2294012695120025D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2156270284785766D+0 + B=0.2681225755444491D-1 + V=0.1722434488736947D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2532385054909710D+0 + B=0.5557495747805614D-1 + V=0.1830237421455091D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2902564617771537D+0 + B=0.8569368062950249D-1 + V=0.1923855349997633D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3266979823143256D+0 + B=0.1167367450324135D+0 + V=0.2004067861936271D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3625039627493614D+0 + B=0.1483861994003304D+0 + V=0.2071817297354263D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3975838937548699D+0 + B=0.1803821503011405D+0 + V=0.2128250834102103D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4318396099009774D+0 + B=0.2124962965666424D+0 + V=0.2174513719440102D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4651706555732742D+0 + B=0.2445221837805913D+0 + V=0.2211661839150214D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4974752649620969D+0 + B=0.2762701224322987D+0 + V=0.2240665257813102D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5286517579627517D+0 + B=0.3075627775211328D+0 + V=0.2262439516632620D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5586001195731895D+0 + B=0.3382311089826877D+0 + V=0.2277874557231869D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5872229902021319D+0 + B=0.3681108834741399D+0 + V=0.2287854314454994D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6144258616235123D+0 + B=0.3970397446872839D+0 + V=0.2293268499615575D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2951676508064861D+0 + B=0.2867499538750441D-1 + V=0.1912628201529828D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3335085485472725D+0 + B=0.5867879341903510D-1 + V=0.1992499672238701D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3709561760636381D+0 + B=0.8961099205022284D-1 + V=0.2061275533454027D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4074722861667498D+0 + B=0.1211627927626297D+0 + V=0.2119318215968572D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4429923648839117D+0 + B=0.1530748903554898D+0 + V=0.2167416581882652D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4774428052721736D+0 + B=0.1851176436721877D+0 + V=0.2206430730516600D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5107446539535904D+0 + B=0.2170829107658179D+0 + V=0.2237186938699523D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5428151370542935D+0 + B=0.2487786689026271D+0 + V=0.2260480075032884D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5735699292556964D+0 + B=0.2800239952795016D+0 + V=0.2277098884558542D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6029253794562866D+0 + B=0.3106445702878119D+0 + V=0.2287845715109671D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6307998987073145D+0 + B=0.3404689500841194D+0 + V=0.2293547268236294D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3752652273692719D+0 + B=0.2997145098184479D-1 + V=0.2056073839852528D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4135383879344028D+0 + B=0.6086725898678011D-1 + V=0.2114235865831876D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4506113885153907D+0 + B=0.9238849548435643D-1 + V=0.2163175629770551D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4864401554606072D+0 + B=0.1242786603851851D+0 + V=0.2203392158111650D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5209708076611709D+0 + B=0.1563086731483386D+0 + V=0.2235473176847839D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5541422135830122D+0 + B=0.1882696509388506D+0 + V=0.2260024141501235D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5858880915113817D+0 + B=0.2199672979126059D+0 + V=0.2277675929329182D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6161399390603444D+0 + B=0.2512165482924867D+0 + V=0.2289102112284834D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6448296482255090D+0 + B=0.2818368701871888D+0 + V=0.2295027954625118D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4544796274917948D+0 + B=0.3088970405060312D-1 + V=0.2161281589879992D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4919389072146628D+0 + B=0.6240947677636835D-1 + V=0.2201980477395102D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5279313026985183D+0 + B=0.9430706144280313D-1 + V=0.2234952066593166D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5624169925571135D+0 + B=0.1263547818770374D+0 + V=0.2260540098520838D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5953484627093287D+0 + B=0.1583430788822594D+0 + V=0.2279157981899988D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6266730715339185D+0 + B=0.1900748462555988D+0 + V=0.2291296918565571D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6563363204278871D+0 + B=0.2213599519592567D+0 + V=0.2297533752536649D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5314574716585696D+0 + B=0.3152508811515374D-1 + V=0.2234927356465995D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5674614932298185D+0 + B=0.6343865291465561D-1 + V=0.2261288012985219D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6017706004970264D+0 + B=0.9551503504223951D-1 + V=0.2280818160923688D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6343471270264178D+0 + B=0.1275440099801196D+0 + V=0.2293773295180159D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6651494599127802D+0 + B=0.1593252037671960D+0 + V=0.2300528767338634D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6050184986005704D+0 + B=0.3192538338496105D-1 + V=0.2281893855065666D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6390163550880400D+0 + B=0.6402824353962306D-1 + V=0.2295720444840727D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6711199107088448D+0 + B=0.9609805077002909D-1 + V=0.2303227649026753D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6741354429572275D+0 + B=0.3211853196273233D-1 + V=0.2304831913227114D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD5294(X,Y,Z,W,N) + DOUBLE PRECISION X(5294) + DOUBLE PRECISION Y(5294) + DOUBLE PRECISION Z(5294) + DOUBLE PRECISION W(5294) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 5294-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.9080510764308163D-4 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.2084824361987793D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2303261686261450D-1 + V=0.5011105657239616D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3757208620162394D-1 + V=0.5942520409683854D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5821912033821852D-1 + V=0.9564394826109721D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8403127529194872D-1 + V=0.1185530657126338D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1122927798060578D+0 + V=0.1364510114230331D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1420125319192987D+0 + V=0.1505828825605415D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1726396437341978D+0 + V=0.1619298749867023D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2038170058115696D+0 + V=0.1712450504267789D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2352849892876508D+0 + V=0.1789891098164999D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2668363354312461D+0 + V=0.1854474955629795D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2982941279900452D+0 + V=0.1908148636673661D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3295002922087076D+0 + V=0.1952377405281833D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3603094918363593D+0 + V=0.1988349254282232D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3905857895173920D+0 + V=0.2017079807160050D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4202005758160837D+0 + V=0.2039473082709094D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4490310061597227D+0 + V=0.2056360279288953D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4769586160311491D+0 + V=0.2068525823066865D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5038679887049750D+0 + V=0.2076724877534488D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5296454286519961D+0 + V=0.2081694278237885D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5541776207164850D+0 + V=0.2084157631219326D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5990467321921213D+0 + V=0.2084381531128593D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6191467096294587D+0 + V=0.2083476277129307D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6375251212901849D+0 + V=0.2082686194459732D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6540514381131168D+0 + V=0.2082475686112415D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6685899064391510D+0 + V=0.2083139860289915D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6810013009681648D+0 + V=0.2084745561831237D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6911469578730340D+0 + V=0.2087091313375890D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6988956915141736D+0 + V=0.2089718413297697D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7041335794868720D+0 + V=0.2092003303479793D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7067754398018567D+0 + V=0.2093336148263241D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3840368707853623D-1 + V=0.7591708117365267D-4 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9835485954117399D-1 + V=0.1083383968169186D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1665774947612998D+0 + V=0.1403019395292510D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2405702335362910D+0 + V=0.1615970179286436D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3165270770189046D+0 + V=0.1771144187504911D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3927386145645443D+0 + V=0.1887760022988168D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4678825918374656D+0 + V=0.1973474670768214D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5408022024266935D+0 + V=0.2033787661234659D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6104967445752438D+0 + V=0.2072343626517331D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6760910702685738D+0 + V=0.2091177834226918D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6655644120217392D-1 + B=0.1936508874588424D-1 + V=0.9316684484675566D-4 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9446246161270182D-1 + B=0.4252442002115869D-1 + V=0.1116193688682976D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1242651925452509D+0 + B=0.6806529315354374D-1 + V=0.1298623551559414D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1553438064846751D+0 + B=0.9560957491205369D-1 + V=0.1450236832456426D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1871137110542670D+0 + B=0.1245931657452888D+0 + V=0.1572719958149914D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2192612628836257D+0 + B=0.1545385828778978D+0 + V=0.1673234785867195D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2515682807206955D+0 + B=0.1851004249723368D+0 + V=0.1756860118725188D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2838535866287290D+0 + B=0.2160182608272384D+0 + V=0.1826776290439367D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3159578817528521D+0 + B=0.2470799012277111D+0 + V=0.1885116347992865D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3477370882791392D+0 + B=0.2781014208986402D+0 + V=0.1933457860170574D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3790576960890540D+0 + B=0.3089172523515731D+0 + V=0.1973060671902064D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4097938317810200D+0 + B=0.3393750055472244D+0 + V=0.2004987099616311D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4398256572859637D+0 + B=0.3693322470987730D+0 + V=0.2030170909281499D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4690384114718480D+0 + B=0.3986541005609877D+0 + V=0.2049461460119080D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4973216048301053D+0 + B=0.4272112491408562D+0 + V=0.2063653565200186D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5245681526132446D+0 + B=0.4548781735309936D+0 + V=0.2073507927381027D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5506733911803888D+0 + B=0.4815315355023251D+0 + V=0.2079764593256122D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5755339829522475D+0 + B=0.5070486445801855D+0 + V=0.2083150534968778D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1305472386056362D+0 + B=0.2284970375722366D-1 + V=0.1262715121590664D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1637327908216477D+0 + B=0.4812254338288384D-1 + V=0.1414386128545972D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1972734634149637D+0 + B=0.7531734457511935D-1 + V=0.1538740401313898D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2308694653110130D+0 + B=0.1039043639882017D+0 + V=0.1642434942331432D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2643899218338160D+0 + B=0.1334526587117626D+0 + V=0.1729790609237496D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2977171599622171D+0 + B=0.1636414868936382D+0 + V=0.1803505190260828D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3307293903032310D+0 + B=0.1942195406166568D+0 + V=0.1865475350079657D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3633069198219073D+0 + B=0.2249752879943753D+0 + V=0.1917182669679069D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3953346955922727D+0 + B=0.2557218821820032D+0 + V=0.1959851709034382D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4267018394184914D+0 + B=0.2862897925213193D+0 + V=0.1994529548117882D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4573009622571704D+0 + B=0.3165224536636518D+0 + V=0.2022138911146548D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4870279559856109D+0 + B=0.3462730221636496D+0 + V=0.2043518024208592D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5157819581450322D+0 + B=0.3754016870282835D+0 + V=0.2059450313018110D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5434651666465393D+0 + B=0.4037733784993613D+0 + V=0.2070685715318472D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5699823887764627D+0 + B=0.4312557784139123D+0 + V=0.2077955310694373D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5952403350947741D+0 + B=0.4577175367122110D+0 + V=0.2081980387824712D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2025152599210369D+0 + B=0.2520253617719557D-1 + V=0.1521318610377956D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2381066653274425D+0 + B=0.5223254506119000D-1 + V=0.1622772720185755D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2732823383651612D+0 + B=0.8060669688588620D-1 + V=0.1710498139420709D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3080137692611118D+0 + B=0.1099335754081255D+0 + V=0.1785911149448736D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3422405614587601D+0 + B=0.1399120955959857D+0 + V=0.1850125313687736D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3758808773890420D+0 + B=0.1702977801651705D+0 + V=0.1904229703933298D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4088458383438932D+0 + B=0.2008799256601680D+0 + V=0.1949259956121987D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4410450550841152D+0 + B=0.2314703052180836D+0 + V=0.1986161545363960D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4723879420561312D+0 + B=0.2618972111375892D+0 + V=0.2015790585641370D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5027843561874343D+0 + B=0.2920013195600270D+0 + V=0.2038934198707418D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5321453674452458D+0 + B=0.3216322555190551D+0 + V=0.2056334060538251D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5603839113834030D+0 + B=0.3506456615934198D+0 + V=0.2068705959462289D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5874150706875146D+0 + B=0.3789007181306267D+0 + V=0.2076753906106002D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6131559381660038D+0 + B=0.4062580170572782D+0 + V=0.2081179391734803D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2778497016394506D+0 + B=0.2696271276876226D-1 + V=0.1700345216228943D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3143733562261912D+0 + B=0.5523469316960465D-1 + V=0.1774906779990410D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3501485810261827D+0 + B=0.8445193201626464D-1 + V=0.1839659377002642D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3851430322303653D+0 + B=0.1143263119336083D+0 + V=0.1894987462975169D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4193013979470415D+0 + B=0.1446177898344475D+0 + V=0.1941548809452595D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4525585960458567D+0 + B=0.1751165438438091D+0 + V=0.1980078427252384D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4848447779622947D+0 + B=0.2056338306745660D+0 + V=0.2011296284744488D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5160871208276894D+0 + B=0.2359965487229226D+0 + V=0.2035888456966776D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5462112185696926D+0 + B=0.2660430223139146D+0 + V=0.2054516325352142D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5751425068101757D+0 + B=0.2956193664498032D+0 + V=0.2067831033092635D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6028073872853596D+0 + B=0.3245763905312779D+0 + V=0.2076485320284876D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6291338275278409D+0 + B=0.3527670026206972D+0 + V=0.2081141439525255D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3541797528439391D+0 + B=0.2823853479435550D-1 + V=0.1834383015469222D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3908234972074657D+0 + B=0.5741296374713106D-1 + V=0.1889540591777677D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4264408450107590D+0 + B=0.8724646633650199D-1 + V=0.1936677023597375D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4609949666553286D+0 + B=0.1175034422915616D+0 + V=0.1976176495066504D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4944389496536006D+0 + B=0.1479755652628428D+0 + V=0.2008536004560983D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5267194884346086D+0 + B=0.1784740659484352D+0 + V=0.2034280351712291D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5577787810220990D+0 + B=0.2088245700431244D+0 + V=0.2053944466027758D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5875563763536670D+0 + B=0.2388628136570763D+0 + V=0.2068077642882360D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6159910016391269D+0 + B=0.2684308928769185D+0 + V=0.2077250949661599D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6430219602956268D+0 + B=0.2973740761960252D+0 + V=0.2082062440705320D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4300647036213646D+0 + B=0.2916399920493977D-1 + V=0.1934374486546626D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4661486308935531D+0 + B=0.5898803024755659D-1 + V=0.1974107010484300D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5009658555287261D+0 + B=0.8924162698525409D-1 + V=0.2007129290388658D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5344824270447704D+0 + B=0.1197185199637321D+0 + V=0.2033736947471293D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5666575997416371D+0 + B=0.1502300756161382D+0 + V=0.2054287125902493D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5974457471404752D+0 + B=0.1806004191913564D+0 + V=0.2069184936818894D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6267984444116886D+0 + B=0.2106621764786252D+0 + V=0.2078883689808782D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6546664713575417D+0 + B=0.2402526932671914D+0 + V=0.2083886366116359D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5042711004437253D+0 + B=0.2982529203607657D-1 + V=0.2006593275470817D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5392127456774380D+0 + B=0.6008728062339922D-1 + V=0.2033728426135397D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5726819437668618D+0 + B=0.9058227674571398D-1 + V=0.2055008781377608D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6046469254207278D+0 + B=0.1211219235803400D+0 + V=0.2070651783518502D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6350716157434952D+0 + B=0.1515286404791580D+0 + V=0.2080953335094320D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6639177679185454D+0 + B=0.1816314681255552D+0 + V=0.2086284998988521D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5757276040972253D+0 + B=0.3026991752575440D-1 + V=0.2055549387644668D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6090265823139755D+0 + B=0.6078402297870770D-1 + V=0.2071871850267654D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6406735344387661D+0 + B=0.9135459984176636D-1 + V=0.2082856600431965D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6706397927793709D+0 + B=0.1218024155966590D+0 + V=0.2088705858819358D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6435019674426665D+0 + B=0.3052608357660639D-1 + V=0.2083995867536322D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6747218676375681D+0 + B=0.6112185773983089D-1 + V=0.2090509712889637D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + SUBROUTINE LD5810(X,Y,Z,W,N) + DOUBLE PRECISION X(5810) + DOUBLE PRECISION Y(5810) + DOUBLE PRECISION Z(5810) + DOUBLE PRECISION W(5810) + INTEGER N + DOUBLE PRECISION A,B,V +CVW +CVW LEBEDEV 5810-POINT ANGULAR GRID +CVW +chvd +chvd This subroutine is part of a set of subroutines that generate +chvd Lebedev grids [1-6] for integration on a sphere. The original +chvd C-code [1] was kindly provided by Dr. Dmitri N. Laikov and +chvd translated into fortran by Dr. Christoph van Wuellen. +chvd This subroutine was translated using a C to fortran77 conversion +chvd tool written by Dr. Christoph van Wuellen. +chvd +chvd Users of this code are asked to include reference [1] in their +chvd publications, and in the user- and programmers-manuals +chvd describing their codes. +chvd +chvd This code was distributed through CCL (http://www.ccl.net/). +chvd +chvd [1] V.I. Lebedev, and D.N. Laikov +chvd "A quadrature formula for the sphere of the 131st +chvd algebraic order of accuracy" +chvd Doklady Mathematics, Vol. 59, No. 3, 1999, pp. 477-481. +chvd +chvd [2] V.I. Lebedev +chvd "A quadrature formula for the sphere of 59th algebraic +chvd order of accuracy" +chvd Russian Acad. Sci. Dokl. Math., Vol. 50, 1995, pp. 283-286. +chvd +chvd [3] V.I. Lebedev, and A.L. Skorokhodov +chvd "Quadrature formulas of orders 41, 47, and 53 for the sphere" +chvd Russian Acad. Sci. Dokl. Math., Vol. 45, 1992, pp. 587-592. +chvd +chvd [4] V.I. Lebedev +chvd "Spherical quadrature formulas exact to orders 25-29" +chvd Siberian Mathematical Journal, Vol. 18, 1977, pp. 99-107. +chvd +chvd [5] V.I. Lebedev +chvd "Quadratures on a sphere" +chvd Computational Mathematics and Mathematical Physics, Vol. 16, +chvd 1976, pp. 10-24. +chvd +chvd [6] V.I. Lebedev +chvd "Values of the nodes and weights of ninth to seventeenth +chvd order Gauss-Markov quadrature formulae invariant under the +chvd octahedron group with inversion" +chvd Computational Mathematics and Mathematical Physics, Vol. 15, +chvd 1975, pp. 44-51. +chvd + N=1 + V=0.9735347946175486D-5 + Call GEN_OH( 1, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1907581241803167D-3 + Call GEN_OH( 2, N, X(N), Y(N), Z(N), W(N), A, B, V) + V=0.1901059546737578D-3 + Call GEN_OH( 3, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1182361662400277D-1 + V=0.3926424538919212D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3062145009138958D-1 + V=0.6667905467294382D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5329794036834243D-1 + V=0.8868891315019135D-4 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7848165532862220D-1 + V=0.1066306000958872D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1054038157636201D+0 + V=0.1214506743336128D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1335577797766211D+0 + V=0.1338054681640871D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1625769955502252D+0 + V=0.1441677023628504D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1921787193412792D+0 + V=0.1528880200826557D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2221340534690548D+0 + V=0.1602330623773609D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2522504912791132D+0 + V=0.1664102653445244D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2823610860679697D+0 + V=0.1715845854011323D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3123173966267560D+0 + V=0.1758901000133069D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3419847036953789D+0 + V=0.1794382485256736D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3712386456999758D+0 + V=0.1823238106757407D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3999627649876828D+0 + V=0.1846293252959976D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4280466458648093D+0 + V=0.1864284079323098D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4553844360185711D+0 + V=0.1877882694626914D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4818736094437834D+0 + V=0.1887716321852025D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5074138709260629D+0 + V=0.1894381638175673D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5319061304570707D+0 + V=0.1898454899533629D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5552514978677286D+0 + V=0.1900497929577815D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5981009025246183D+0 + V=0.1900671501924092D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6173990192228116D+0 + V=0.1899837555533510D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6351365239411131D+0 + V=0.1899014113156229D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6512010228227200D+0 + V=0.1898581257705106D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6654758363948120D+0 + V=0.1898804756095753D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6778410414853370D+0 + V=0.1899793610426402D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6881760887484110D+0 + V=0.1901464554844117D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6963645267094598D+0 + V=0.1903533246259542D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7023010617153579D+0 + V=0.1905556158463228D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.7059004636628753D+0 + V=0.1907037155663528D-3 + Call GEN_OH( 4, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3552470312472575D-1 + V=0.5992997844249967D-4 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.9151176620841283D-1 + V=0.9749059382456978D-4 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1566197930068980D+0 + V=0.1241680804599158D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2265467599271907D+0 + V=0.1437626154299360D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2988242318581361D+0 + V=0.1584200054793902D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3717482419703886D+0 + V=0.1694436550982744D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4440094491758889D+0 + V=0.1776617014018108D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5145337096756642D+0 + V=0.1836132434440077D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5824053672860230D+0 + V=0.1876494727075983D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6468283961043370D+0 + V=0.1899906535336482D-3 + Call GEN_OH( 5, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6095964259104373D-1 + B=0.1787828275342931D-1 + V=0.8143252820767350D-4 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.8811962270959388D-1 + B=0.3953888740792096D-1 + V=0.9998859890887728D-4 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1165936722428831D+0 + B=0.6378121797722990D-1 + V=0.1156199403068359D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1460232857031785D+0 + B=0.8985890813745037D-1 + V=0.1287632092635513D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1761197110181755D+0 + B=0.1172606510576162D+0 + V=0.1398378643365139D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2066471190463718D+0 + B=0.1456102876970995D+0 + V=0.1491876468417391D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2374076026328152D+0 + B=0.1746153823011775D+0 + V=0.1570855679175456D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2682305474337051D+0 + B=0.2040383070295584D+0 + V=0.1637483948103775D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2989653312142369D+0 + B=0.2336788634003698D+0 + V=0.1693500566632843D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3294762752772209D+0 + B=0.2633632752654219D+0 + V=0.1740322769393633D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3596390887276086D+0 + B=0.2929369098051601D+0 + V=0.1779126637278296D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3893383046398812D+0 + B=0.3222592785275512D+0 + V=0.1810908108835412D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4184653789358347D+0 + B=0.3512004791195743D+0 + V=0.1836529132600190D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4469172319076166D+0 + B=0.3796385677684537D+0 + V=0.1856752841777379D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4745950813276976D+0 + B=0.4074575378263879D+0 + V=0.1872270566606832D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5014034601410262D+0 + B=0.4345456906027828D+0 + V=0.1883722645591307D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5272493404551239D+0 + B=0.4607942515205134D+0 + V=0.1891714324525297D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5520413051846366D+0 + B=0.4860961284181720D+0 + V=0.1896827480450146D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5756887237503077D+0 + B=0.5103447395342790D+0 + V=0.1899628417059528D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1225039430588352D+0 + B=0.2136455922655793D-1 + V=0.1123301829001669D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1539113217321372D+0 + B=0.4520926166137188D-1 + V=0.1253698826711277D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1856213098637712D+0 + B=0.7086468177864818D-1 + V=0.1366266117678531D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2174998728035131D+0 + B=0.9785239488772918D-1 + V=0.1462736856106918D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2494128336938330D+0 + B=0.1258106396267210D+0 + V=0.1545076466685412D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2812321562143480D+0 + B=0.1544529125047001D+0 + V=0.1615096280814007D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3128372276456111D+0 + B=0.1835433512202753D+0 + V=0.1674366639741759D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3441145160177973D+0 + B=0.2128813258619585D+0 + V=0.1724225002437900D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3749567714853510D+0 + B=0.2422913734880829D+0 + V=0.1765810822987288D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4052621732015610D+0 + B=0.2716163748391453D+0 + V=0.1800104126010751D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4349335453522385D+0 + B=0.3007127671240280D+0 + V=0.1827960437331284D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4638776641524965D+0 + B=0.3294470677216479D+0 + V=0.1850140300716308D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4920046410462687D+0 + B=0.3576932543699155D+0 + V=0.1867333507394938D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5192273554861704D+0 + B=0.3853307059757764D+0 + V=0.1880178688638289D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5454609081136522D+0 + B=0.4122425044452694D+0 + V=0.1889278925654758D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5706220661424140D+0 + B=0.4383139587781027D+0 + V=0.1895213832507346D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5946286755181518D+0 + B=0.4634312536300553D+0 + V=0.1898548277397420D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.1905370790924295D+0 + B=0.2371311537781979D-1 + V=0.1349105935937341D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2242518717748009D+0 + B=0.4917878059254806D-1 + V=0.1444060068369326D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2577190808025936D+0 + B=0.7595498960495142D-1 + V=0.1526797390930008D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2908724534927187D+0 + B=0.1036991083191100D+0 + V=0.1598208771406474D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3236354020056219D+0 + B=0.1321348584450234D+0 + V=0.1659354368615331D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3559267359304543D+0 + B=0.1610316571314789D+0 + V=0.1711279910946440D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3876637123676956D+0 + B=0.1901912080395707D+0 + V=0.1754952725601440D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4187636705218842D+0 + B=0.2194384950137950D+0 + V=0.1791247850802529D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4491449019883107D+0 + B=0.2486155334763858D+0 + V=0.1820954300877716D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4787270932425445D+0 + B=0.2775768931812335D+0 + V=0.1844788524548449D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5074315153055574D+0 + B=0.3061863786591120D+0 + V=0.1863409481706220D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5351810507738336D+0 + B=0.3343144718152556D+0 + V=0.1877433008795068D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5619001025975381D+0 + B=0.3618362729028427D+0 + V=0.1887444543705232D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5875144035268046D+0 + B=0.3886297583620408D+0 + V=0.1894009829375006D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6119507308734495D+0 + B=0.4145742277792031D+0 + V=0.1897683345035198D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2619733870119463D+0 + B=0.2540047186389353D-1 + V=0.1517327037467653D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.2968149743237949D+0 + B=0.5208107018543989D-1 + V=0.1587740557483543D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3310451504860488D+0 + B=0.7971828470885599D-1 + V=0.1649093382274097D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3646215567376676D+0 + B=0.1080465999177927D+0 + V=0.1701915216193265D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3974916785279360D+0 + B=0.1368413849366629D+0 + V=0.1746847753144065D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4295967403772029D+0 + B=0.1659073184763559D+0 + V=0.1784555512007570D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4608742854473447D+0 + B=0.1950703730454614D+0 + V=0.1815687562112174D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4912598858949903D+0 + B=0.2241721144376724D+0 + V=0.1840864370663302D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5206882758945558D+0 + B=0.2530655255406489D+0 + V=0.1860676785390006D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5490940914019819D+0 + B=0.2816118409731066D+0 + V=0.1875690583743703D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5764123302025542D+0 + B=0.3096780504593238D+0 + V=0.1886453236347225D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6025786004213506D+0 + B=0.3371348366394987D+0 + V=0.1893501123329645D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6275291964794956D+0 + B=0.3638547827694396D+0 + V=0.1897366184519868D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3348189479861771D+0 + B=0.2664841935537443D-1 + V=0.1643908815152736D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.3699515545855295D+0 + B=0.5424000066843495D-1 + V=0.1696300350907768D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4042003071474669D+0 + B=0.8251992715430854D-1 + V=0.1741553103844483D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4375320100182624D+0 + B=0.1112695182483710D+0 + V=0.1780015282386092D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4699054490335947D+0 + B=0.1402964116467816D+0 + V=0.1812116787077125D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5012739879431952D+0 + B=0.1694275117584291D+0 + V=0.1838323158085421D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5315874883754966D+0 + B=0.1985038235312689D+0 + V=0.1859113119837737D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5607937109622117D+0 + B=0.2273765660020893D+0 + V=0.1874969220221698D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5888393223495521D+0 + B=0.2559041492849764D+0 + V=0.1886375612681076D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6156705979160163D+0 + B=0.2839497251976899D+0 + V=0.1893819575809276D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6412338809078123D+0 + B=0.3113791060500690D+0 + V=0.1897794748256767D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4076051259257167D+0 + B=0.2757792290858463D-1 + V=0.1738963926584846D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4423788125791520D+0 + B=0.5584136834984293D-1 + V=0.1777442359873466D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4760480917328258D+0 + B=0.8457772087727143D-1 + V=0.1810010815068719D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5085838725946297D+0 + B=0.1135975846359248D+0 + V=0.1836920318248129D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5399513637391218D+0 + B=0.1427286904765053D+0 + V=0.1858489473214328D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5701118433636380D+0 + B=0.1718112740057635D+0 + V=0.1875079342496592D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5990240530606021D+0 + B=0.2006944855985351D+0 + V=0.1887080239102310D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6266452685139695D+0 + B=0.2292335090598907D+0 + V=0.1894905752176822D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6529320971415942D+0 + B=0.2572871512353714D+0 + V=0.1898991061200695D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.4791583834610126D+0 + B=0.2826094197735932D-1 + V=0.1809065016458791D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5130373952796940D+0 + B=0.5699871359683649D-1 + V=0.1836297121596799D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5456252429628476D+0 + B=0.8602712528554394D-1 + V=0.1858426916241869D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5768956329682385D+0 + B=0.1151748137221281D+0 + V=0.1875654101134641D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6068186944699046D+0 + B=0.1442811654136362D+0 + V=0.1888240751833503D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6353622248024907D+0 + B=0.1731930321657680D+0 + V=0.1896497383866979D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6624927035731797D+0 + B=0.2017619958756061D+0 + V=0.1900775530219121D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5484933508028488D+0 + B=0.2874219755907391D-1 + V=0.1858525041478814D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.5810207682142106D+0 + B=0.5778312123713695D-1 + V=0.1876248690077947D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6120955197181352D+0 + B=0.8695262371439526D-1 + V=0.1889404439064607D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6416944284294319D+0 + B=0.1160893767057166D+0 + V=0.1898168539265290D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6697926391731260D+0 + B=0.1450378826743251D+0 + V=0.1902779940661772D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6147594390585488D+0 + B=0.2904957622341456D-1 + V=0.1890125641731815D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6455390026356783D+0 + B=0.5823809152617197D-1 + V=0.1899434637795751D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6747258588365477D+0 + B=0.8740384899884715D-1 + V=0.1904520856831751D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + A=0.6772135750395347D+0 + B=0.2919946135808105D-1 + V=0.1905534498734563D-3 + Call GEN_OH( 6, N, X(N), Y(N), Z(N), W(N), A, B, V) + N=N-1 + RETURN + END + + diff --git a/plugins/DFT_Utils/functional.irp.f b/plugins/DFT_Utils/functional.irp.f new file mode 100644 index 00000000..8bcb7d80 --- /dev/null +++ b/plugins/DFT_Utils/functional.irp.f @@ -0,0 +1,25 @@ +double precision function ex_lda(rho) + include 'constants.include.F' + implicit none + double precision, intent(in) :: rho + ex_lda = cst_lda * rho**(c_4_3) + +end + +BEGIN_PROVIDER [double precision, lda_exchange, (N_states)] + implicit none + integer :: i,j,k,l + double precision :: ex_lda + do l = 1, N_states + lda_exchange(l) = 0.d0 + do j = 1, nucl_num + do i = 1, n_points_radial_grid + do k = 1, n_points_integration_angular + lda_exchange(l) += final_weight_functions_at_grid_points(k,i,j) * & + (ex_lda(one_body_dm_mo_alpha_at_grid_points(k,i,j,l)) + ex_lda(one_body_dm_mo_beta_at_grid_points(k,i,j,l))) + enddo + enddo + enddo + enddo + +END_PROVIDER diff --git a/plugins/DFT_Utils/grid_density.irp.f b/plugins/DFT_Utils/grid_density.irp.f index 6071a18b..ad5e0d51 100644 --- a/plugins/DFT_Utils/grid_density.irp.f +++ b/plugins/DFT_Utils/grid_density.irp.f @@ -1,7 +1,7 @@ -BEGIN_PROVIDER [integer, n_points_angular_grid] + BEGIN_PROVIDER [integer, n_points_integration_angular] implicit none - n_points_angular_grid = 50 -END_PROVIDER + n_points_integration_angular = 110 + END_PROVIDER BEGIN_PROVIDER [integer, n_points_radial_grid] implicit none @@ -9,34 +9,52 @@ BEGIN_PROVIDER [integer, n_points_radial_grid] END_PROVIDER - BEGIN_PROVIDER [double precision, angular_quadrature_points, (n_points_angular_grid,3) ] -&BEGIN_PROVIDER [double precision, weights_angular_points, (n_points_angular_grid)] + BEGIN_PROVIDER [double precision, angular_quadrature_points, (n_points_integration_angular,3) ] +&BEGIN_PROVIDER [double precision, weights_angular_points, (n_points_integration_angular)] implicit none BEGIN_DOC ! weights and grid points for the integration on the angular variables on ! the unit sphere centered on (0,0,0) ! According to the LEBEDEV scheme END_DOC - call cal_quad(n_points_angular_grid, angular_quadrature_points,weights_angular_points) + angular_quadrature_points = 0.d0 + weights_angular_points = 0.d0 +!call cal_quad(n_points_integration_angular, angular_quadrature_points,weights_angular_points) include 'constants.include.F' - integer :: i + integer :: i,n double precision :: accu double precision :: degre_rad -!degre_rad = 180.d0/pi -!accu = 0.d0 -!do i = 1, n_points_integration_angular_lebedev + degre_rad = pi/180.d0 + accu = 0.d0 + double precision :: x(n_points_integration_angular),y(n_points_integration_angular),z(n_points_integration_angular),w(n_points_integration_angular) + call LD0110(X,Y,Z,W,N) + do i = 1, n_points_integration_angular + angular_quadrature_points(i,1) = x(i) + angular_quadrature_points(i,2) = y(i) + angular_quadrature_points(i,3) = z(i) + weights_angular_points(i) = w(i) * 4.d0 * pi + accu += w(i) + enddo +!do i = 1, n_points_integration_angular ! accu += weights_angular_integration_lebedev(i) -! weights_angular_points(i) = weights_angular_integration_lebedev(i) * 2.d0 * pi +! weights_angular_points(i) = weights_angular_integration_lebedev(i) * 4.d0 * pi ! angular_quadrature_points(i,1) = dcos ( degre_rad * theta_angular_integration_lebedev(i)) & ! * dsin ( degre_rad * phi_angular_integration_lebedev(i)) ! angular_quadrature_points(i,2) = dsin ( degre_rad * theta_angular_integration_lebedev(i)) & ! * dsin ( degre_rad * phi_angular_integration_lebedev(i)) ! angular_quadrature_points(i,3) = dcos ( degre_rad * phi_angular_integration_lebedev(i)) + +!!weights_angular_points(i) = weights_angular_integration_lebedev(i) +!!angular_quadrature_points(i,1) = dcos ( degre_rad * phi_angular_integration_lebedev(i)) & +!! * dsin ( degre_rad * theta_angular_integration_lebedev(i)) +!!angular_quadrature_points(i,2) = dsin ( degre_rad * phi_angular_integration_lebedev(i)) & +!! * dsin ( degre_rad * theta_angular_integration_lebedev(i)) +!!angular_quadrature_points(i,3) = dcos ( degre_rad * theta_angular_integration_lebedev(i)) !enddo -!print*,'ANGULAR' -!print*,'' -!print*,'accu = ',accu -!ASSERT( dabs(accu - 1.D0) < 1.d-10) + print*,'ANGULAR' + print*,'' + print*,'accu = ',accu + ASSERT( dabs(accu - 1.D0) < 1.d-10) END_PROVIDER @@ -63,7 +81,7 @@ END_PROVIDER END_PROVIDER -BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_angular_grid,n_points_radial_grid,nucl_num)] +BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_integration_angular,n_points_radial_grid,nucl_num)] BEGIN_DOC ! points for integration over space END_DOC @@ -79,7 +97,7 @@ BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_angular_grid double precision :: x,r x = grid_points_radial(j) ! x value for the mapping of the [0, +\infty] to [0,1] r = knowles_function(alpha_knowles(int(nucl_charge(i))),m_knowles,x) ! value of the radial coordinate for the integration - do k = 1, n_points_angular_grid ! explicit values of the grid points centered around each atom + do k = 1, n_points_integration_angular ! explicit values of the grid points centered around each atom grid_points_per_atom(1,k,j,i) = x_ref + angular_quadrature_points(k,1) * r grid_points_per_atom(2,k,j,i) = y_ref + angular_quadrature_points(k,2) * r grid_points_per_atom(3,k,j,i) = z_ref + angular_quadrature_points(k,3) * r @@ -88,7 +106,7 @@ BEGIN_PROVIDER [double precision, grid_points_per_atom, (3,n_points_angular_grid enddo END_PROVIDER -BEGIN_PROVIDER [double precision, weight_functions_at_grid_points, (n_points_angular_grid,n_points_radial_grid,nucl_num) ] +BEGIN_PROVIDER [double precision, weight_functions_at_grid_points, (n_points_integration_angular,n_points_radial_grid,nucl_num) ] BEGIN_DOC ! Weight function at grid points : w_n(r) according to the equation (22) of Becke original paper (JCP, 88, 1988) ! the "n" discrete variable represents the nucleis which in this array is represented by the last dimension @@ -102,7 +120,7 @@ BEGIN_PROVIDER [double precision, weight_functions_at_grid_points, (n_points_ang ! run over all points in space do j = 1, nucl_num ! that are referred to each atom do k = 1, n_points_radial_grid -1 !for each radial grid attached to the "jth" atom - do l = 1, n_points_angular_grid ! for each angular point attached to the "jth" atom + do l = 1, n_points_integration_angular ! for each angular point attached to the "jth" atom r(1) = grid_points_per_atom(1,l,k,j) r(2) = grid_points_per_atom(2,l,k,j) r(3) = grid_points_per_atom(3,l,k,j) @@ -115,7 +133,6 @@ BEGIN_PROVIDER [double precision, weight_functions_at_grid_points, (n_points_ang enddo accu = 1.d0/accu weight_functions_at_grid_points(l,k,j) = tmp_array(j) * accu -! print*,weight_functions_at_grid_points(l,k,j) enddo enddo enddo @@ -123,43 +140,64 @@ BEGIN_PROVIDER [double precision, weight_functions_at_grid_points, (n_points_ang END_PROVIDER - BEGIN_PROVIDER [double precision, one_body_dm_mo_alpha_at_grid_points, (n_points_angular_grid,n_points_radial_grid,nucl_num) ] -&BEGIN_PROVIDER [double precision, one_body_dm_mo_beta_at_grid_points, (n_points_angular_grid,n_points_radial_grid,nucl_num) ] +BEGIN_PROVIDER [double precision, final_weight_functions_at_grid_points, (n_points_integration_angular,n_points_radial_grid,nucl_num) ] + BEGIN_DOC +! Weight function at grid points : w_n(r) according to the equation (22) of Becke original paper (JCP, 88, 1988) +! the "n" discrete variable represents the nucleis which in this array is represented by the last dimension +! and the points are labelled by the other dimensions + END_DOC implicit none integer :: i,j,k,l,m + double precision :: r(3) + double precision :: accu,cell_function_becke + double precision :: tmp_array(nucl_num) + double precision :: contrib_integration,x + double precision :: derivative_knowles_function,knowles_function + ! run over all points in space + do j = 1, nucl_num ! that are referred to each atom + do i = 1, n_points_radial_grid -1 !for each radial grid attached to the "jth" atom + x = grid_points_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1] + do k = 1, n_points_integration_angular ! for each angular point attached to the "jth" atom + contrib_integration = derivative_knowles_function(alpha_knowles(int(nucl_charge(j))),m_knowles,x) & + *knowles_function(alpha_knowles(int(nucl_charge(j))),m_knowles,x)**2 + final_weight_functions_at_grid_points(k,i,j) = weights_angular_points(k) * weight_functions_at_grid_points(k,i,j) * contrib_integration * dr_radial_integral + enddo + enddo + enddo + +END_PROVIDER + + + BEGIN_PROVIDER [double precision, one_body_dm_mo_alpha_at_grid_points, (n_points_integration_angular,n_points_radial_grid,nucl_num,N_states) ] +&BEGIN_PROVIDER [double precision, one_body_dm_mo_beta_at_grid_points, (n_points_integration_angular,n_points_radial_grid,nucl_num,N_states) ] + implicit none + integer :: i,j,k,l,m,i_state double precision :: contrib double precision :: r(3) double precision :: aos_array(ao_num),mos_array(mo_tot_num) + do i_state = 1, N_states do j = 1, nucl_num - do k = 1, n_points_radial_grid -1 - do l = 1, n_points_angular_grid - one_body_dm_mo_alpha_at_grid_points(l,k,j) = 0.d0 - one_body_dm_mo_beta_at_grid_points(l,k,j) = 0.d0 + do k = 1, n_points_radial_grid + do l = 1, n_points_integration_angular + one_body_dm_mo_alpha_at_grid_points(l,k,j,i_state) = 0.d0 + one_body_dm_mo_beta_at_grid_points(l,k,j,i_state) = 0.d0 r(1) = grid_points_per_atom(1,l,k,j) r(2) = grid_points_per_atom(2,l,k,j) r(3) = grid_points_per_atom(3,l,k,j) -! call give_all_aos_at_r(r,aos_array) -! do i = 1, ao_num -! do m = 1, ao_num -! contrib = aos_array(i) * aos_array(m) -! one_body_dm_mo_alpha_at_grid_points(l,k,j) += one_body_dm_ao_alpha(i,m) * contrib -! one_body_dm_mo_beta_at_grid_points(l,k,j) += one_body_dm_ao_beta(i,m) * contrib -! enddo -! enddo - call give_all_mos_at_r(r,mos_array) - do i = 1, mo_tot_num - do m = 1, mo_tot_num + do m = 1, mo_tot_num + do i = 1, mo_tot_num contrib = mos_array(i) * mos_array(m) - one_body_dm_mo_alpha_at_grid_points(l,k,j) += one_body_dm_mo_alpha(i,m) * contrib - one_body_dm_mo_beta_at_grid_points(l,k,j) += one_body_dm_mo_beta(i,m) * contrib + one_body_dm_mo_alpha_at_grid_points(l,k,j,i_state) += one_body_dm_mo_alpha(i,m,i_state) * contrib + one_body_dm_mo_beta_at_grid_points(l,k,j,i_state) += one_body_dm_mo_beta(i,m,i_state) * contrib enddo enddo enddo enddo enddo + enddo END_PROVIDER diff --git a/plugins/DFT_Utils/integration_3d.irp.f b/plugins/DFT_Utils/integration_3d.irp.f index 43eb1ab8..a665349a 100644 --- a/plugins/DFT_Utils/integration_3d.irp.f +++ b/plugins/DFT_Utils/integration_3d.irp.f @@ -4,18 +4,11 @@ double precision function step_function_becke(x) double precision :: f_function_becke integer :: i,n_max_becke -!if(x.lt.-1.d0)then -! step_function_becke = 0.d0 -!else if (x .gt.1)then -! step_function_becke = 0.d0 -!else step_function_becke = f_function_becke(x) -!!n_max_becke = 1 - do i = 1, 4 + do i = 1,5 step_function_becke = f_function_becke(step_function_becke) enddo step_function_becke = 0.5d0*(1.d0 - step_function_becke) -!endif end double precision function f_function_becke(x) diff --git a/plugins/DFT_Utils/integration_radial.irp.f b/plugins/DFT_Utils/integration_radial.irp.f index 4943783b..0708658f 100644 --- a/plugins/DFT_Utils/integration_radial.irp.f +++ b/plugins/DFT_Utils/integration_radial.irp.f @@ -4,7 +4,7 @@ double precision :: accu integer :: i,j,k,l double precision :: x - double precision :: integrand(n_points_angular_grid), weights(n_points_angular_grid) + double precision :: integrand(n_points_integration_angular), weights(n_points_integration_angular) double precision :: f_average_angular_alpha,f_average_angular_beta double precision :: derivative_knowles_function,knowles_function @@ -12,7 +12,7 @@ ! according ot equation (6) of the paper of Becke (JCP, (88), 1988) ! Here the m index is referred to the w_m(r) weight functions of equation (22) ! Run over all points of integrations : there are - ! n_points_radial_grid (i) * n_points_angular_grid (k) + ! n_points_radial_grid (i) * n_points_integration_angular (k) do j = 1, nucl_num integral_density_alpha_knowles_becke_per_atom(j) = 0.d0 integral_density_beta_knowles_becke_per_atom(j) = 0.d0 @@ -20,14 +20,13 @@ ! Angular integration over the solid angle Omega for a FIXED angular coordinate "r" f_average_angular_alpha = 0.d0 f_average_angular_beta = 0.d0 - do k = 1, n_points_angular_grid - f_average_angular_alpha += weights_angular_points(k) * one_body_dm_mo_alpha_at_grid_points(k,i,j) * weight_functions_at_grid_points(k,i,j) - f_average_angular_beta += weights_angular_points(k) * one_body_dm_mo_beta_at_grid_points(k,i,j) * weight_functions_at_grid_points(k,i,j) + do k = 1, n_points_integration_angular + f_average_angular_alpha += weights_angular_points(k) * one_body_dm_mo_alpha_at_grid_points(k,i,j,1) * weight_functions_at_grid_points(k,i,j) + f_average_angular_beta += weights_angular_points(k) * one_body_dm_mo_beta_at_grid_points(k,i,j,1) * weight_functions_at_grid_points(k,i,j) enddo ! x = grid_points_radial(i) ! x value for the mapping of the [0, +\infty] to [0,1] double precision :: contrib_integration -! print*,m_knowles contrib_integration = derivative_knowles_function(alpha_knowles(int(nucl_charge(j))),m_knowles,x) & *knowles_function(alpha_knowles(int(nucl_charge(j))),m_knowles,x)**2 integral_density_alpha_knowles_becke_per_atom(j) += contrib_integration *f_average_angular_alpha diff --git a/plugins/DFT_Utils/test_integration_3d_density.irp.f b/plugins/DFT_Utils/test_integration_3d_density.irp.f index 93ce58f4..dba02805 100644 --- a/plugins/DFT_Utils/test_integration_3d_density.irp.f +++ b/plugins/DFT_Utils/test_integration_3d_density.irp.f @@ -4,13 +4,55 @@ program pouet touch read_wf print*,'m_knowles = ',m_knowles call routine + call routine3 end + + + +subroutine routine3 + implicit none + integer :: i,j,k,l + double precision :: accu + accu = 0.d0 + do j = 1, nucl_num ! that are referred to each atom + do i = 1, n_points_radial_grid -1 !for each radial grid attached to the "jth" atom + do k = 1, n_points_integration_angular ! for each angular point attached to the "jth" atom + accu += final_weight_functions_at_grid_points(k,i,j) * one_body_dm_mo_alpha_at_grid_points(k,i,j,1) + enddo + enddo + enddo + print*, accu + print*, 'lda_exchange',lda_exchange + +end +subroutine routine2 + implicit none + integer :: i,j,k,l + double precision :: x,y,z + double precision :: r + double precision :: accu + accu = 0.d0 + r = 1.d0 + do k = 1, n_points_integration_angular + x = angular_quadrature_points(k,1) * r + y = angular_quadrature_points(k,2) * r + z = angular_quadrature_points(k,3) * r + accu += weights_angular_points(k) * (x**2 + y**2 + z**2) + enddo + print*, accu + +end + + subroutine routine implicit none integer :: i double precision :: accu(2) accu = 0.d0 + do i = 1, N_det + call debug_det(psi_det(1,1,i),N_int) + enddo do i = 1, nucl_num accu(1) += integral_density_alpha_knowles_becke_per_atom(i) accu(2) += integral_density_beta_knowles_becke_per_atom(i) @@ -19,6 +61,18 @@ subroutine routine print*,'Nalpha = ',elec_alpha_num print*,'accu(2) = ',accu(2) print*,'Nalpha = ',elec_beta_num + + accu = 0.d0 + do i = 1, mo_tot_num + accu(1) += one_body_dm_mo_alpha_average(i,i) + accu(2) += one_body_dm_mo_beta_average(i,i) + enddo + + + print*,' ' + print*,' ' + print*,'accu(1) = ',accu(1) + print*,'accu(2) = ',accu(2) end diff --git a/plugins/Full_CI_ZMQ/energy.irp.f b/plugins/Full_CI_ZMQ/energy.irp.f index 7b7cc75b..5f9baf46 100644 --- a/plugins/Full_CI_ZMQ/energy.irp.f +++ b/plugins/Full_CI_ZMQ/energy.irp.f @@ -12,7 +12,7 @@ BEGIN_PROVIDER [ double precision, pt2_E0_denominator, (N_states) ] ! E0 in the denominator of the PT2 END_DOC if (initialize_pt2_E0_denominator) then - pt2_E0_denominator(1:N_states) = CI_electronic_energy(1:N_states) + pt2_E0_denominator(1:N_states) = psi_energy(1:N_states) ! pt2_E0_denominator(1:N_states) = HF_energy - nuclear_repulsion ! pt2_E0_denominator(1:N_states) = barycentric_electronic_energy(1:N_states) call write_double(6,pt2_E0_denominator(1)+nuclear_repulsion, 'PT2 Energy denominator') diff --git a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f index 8ffd8e60..914e7138 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch.irp.f @@ -1,8 +1,7 @@ program pt2_stoch implicit none - initialize_pt2_E0_denominator = .False. read_wf = .True. - SOFT_TOUCH initialize_pt2_E0_denominator read_wf + SOFT_TOUCH read_wf PROVIDE mo_bielec_integrals_in_map call run end @@ -17,31 +16,23 @@ subroutine run integer :: n_det_before, to_select double precision :: threshold_davidson_in - double precision :: E_CI_before(N_states), relative_error + double precision :: E_CI_before, relative_error - if (.true.) then - call ezfio_get_full_ci_zmq_energy(E_CI_before(1)) - pt2_e0_denominator(:) = E_CI_before(1) - nuclear_repulsion - SOFT_TOUCH pt2_e0_denominator read_wf - endif allocate (pt2(N_states)) pt2 = 0.d0 + E_CI_before = pt2_E0_denominator(1) + nuclear_repulsion threshold_selectors = 1.d0 threshold_generators = 1d0 - relative_error = 1.d-6 + relative_error = 1.d-3 call ZMQ_pt2(pt2, relative_error) print *, 'Final step' print *, 'N_det = ', N_det - print *, 'N_states = ', N_states - do k=1,N_states - print *, 'State', k - print *, 'PT2 = ', pt2 - print *, 'E = ', E_CI_before - print *, 'E+PT2 = ', E_CI_before+pt2 - print *, '-----' - enddo - call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before(1)+pt2(1)) + print *, 'PT2 = ', pt2 + print *, 'E = ', E_CI_before + print *, 'E+PT2 = ', E_CI_before+pt2 + print *, '-----' + call ezfio_set_full_ci_zmq_energy_pt2(E_CI_before+pt2(1)) end diff --git a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f index eb706ccb..afb1a50c 100644 --- a/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f +++ b/plugins/Full_CI_ZMQ/pt2_stoch_routines.irp.f @@ -20,7 +20,7 @@ subroutine ZMQ_pt2(pt2,relative_error) double precision, allocatable :: pt2_detail(:,:), comb(:) logical, allocatable :: computed(:) integer, allocatable :: tbc(:) - integer :: i, j, Ncomb, generator_per_task, i_generator_end + integer :: i, j, k, Ncomb, generator_per_task, i_generator_end integer, external :: pt2_find double precision :: sumabove(comb_teeth), sum2above(comb_teeth), Nabove(comb_teeth) @@ -32,7 +32,7 @@ subroutine ZMQ_pt2(pt2,relative_error) sum2above = 0d0 Nabove = 0d0 - provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral + provide nproc fragment_first fragment_count mo_bielec_integrals_in_map mo_mono_elec_integral pt2_weight !call random_seed() @@ -69,18 +69,18 @@ subroutine ZMQ_pt2(pt2,relative_error) do i=1,tbc(0) if(tbc(i) > fragment_first) then - write(task(ipos:ipos+20),'(I9,X,I9,''|'')') 0, tbc(i) + write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') 0, tbc(i) ipos += 20 - if (ipos > 64000) then + if (ipos > 63980) then call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20))) ipos=1 tasks = .True. endif else do j=1,fragment_count - write(task(ipos:ipos+20),'(I9,X,I9,''|'')') j, tbc(i) + write(task(ipos:ipos+20),'(I9,1X,I9,''|'')') j, tbc(i) ipos += 20 - if (ipos > 64000) then + if (ipos > 63980) then call add_task_to_taskserver(zmq_to_qp_run_socket,trim(task(1:ipos-20))) ipos=1 tasks = .True. @@ -108,7 +108,12 @@ subroutine ZMQ_pt2(pt2,relative_error) call end_parallel_job(zmq_to_qp_run_socket, 'pt2') else - pt2(1) = sum(pt2_detail(1,:)) + pt2 = 0.d0 + do i=1,N_det_generators + do k=1,N_states + pt2(k) = pt2(k) + pt2_detail(k,i) + enddo + enddo endif tbc(0) = 0 @@ -117,6 +122,7 @@ subroutine ZMQ_pt2(pt2,relative_error) endif end do + deallocate(pt2_detail, comb, computed, tbc) end subroutine @@ -196,11 +202,15 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su allocate(actually_computed(N_det_generators), parts_to_get(N_det_generators), & pt2_mwen(N_states, N_det_generators) ) - actually_computed(:) = computed(:) + do i=1,N_det_generators + actually_computed(i) = computed(i) + enddo parts_to_get(:) = 1 if(fragment_first > 0) then - parts_to_get(1:fragment_first) = fragment_count + do i=1,fragment_first + parts_to_get(i) = fragment_count + enddo endif do i=1,tbc(0) @@ -223,7 +233,7 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su pullLoop : do while (more == 1) call pull_pt2_results(zmq_socket_pull, Nindex, index, pt2_mwen, task_id, ntask) do i=1,Nindex - pt2_detail(:, index(i)) += pt2_mwen(:,i) + pt2_detail(1:N_states, index(i)) += pt2_mwen(1:N_states,i) parts_to_get(index(i)) -= 1 if(parts_to_get(index(i)) < 0) then print *, i, index(i), parts_to_get(index(i)), Nindex @@ -273,12 +283,11 @@ subroutine pt2_collector(b, tbc, comb, Ncomb, computed, pt2_detail, sumabove, su if (dabs(eqt/avg) < relative_error) then pt2(1) = avg ! exit pullLoop + else + print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth) endif - print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth) end if end do pullLoop - print "(4(G22.13), 4(I9))", time - time0, avg, eqt, Nabove(tooth), tooth, first_det_of_teeth(tooth)-1, done, first_det_of_teeth(tooth+1)-first_det_of_teeth(tooth) - call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_pull_socket(zmq_socket_pull) @@ -375,9 +384,9 @@ END_PROVIDER subroutine get_carlo_workbatch(computed, comb, Ncomb, tbc) implicit none + integer, intent(inout) :: Ncomb double precision, intent(out) :: comb(Ncomb) integer, intent(inout) :: tbc(0:size_tbc) - integer, intent(inout) :: Ncomb logical, intent(inout) :: computed(N_det_generators) integer :: i, j, last_full, dets(comb_teeth), tbc_save integer :: icount, n @@ -515,12 +524,15 @@ end subroutine pt2_cweight(i) = pt2_cweight(i-1) + psi_coef_generators(i,1)**2 end do - pt2_weight = pt2_weight / pt2_cweight(N_det_generators) - pt2_cweight = pt2_cweight / pt2_cweight(N_det_generators) + do i=1,N_det_generators + pt2_weight(i) = pt2_weight(i) / pt2_cweight(N_det_generators) + pt2_cweight(i) = pt2_cweight(i) / pt2_cweight(N_det_generators) + enddo norm_left = 1d0 comb_step = 1d0/dfloat(comb_teeth) + first_det_of_comb = 1 do i=1,N_det_generators if(pt2_weight(i)/norm_left < comb_step*.5d0) then first_det_of_comb = i diff --git a/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f b/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f index 452b446b..5a246319 100644 --- a/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_pt2_slave.irp.f @@ -25,7 +25,7 @@ subroutine run_pt2_slave(thread,iproc,energy) integer :: index integer :: Nindex - allocate(pt2_detail(N_states, N_det)) + allocate(pt2_detail(N_states, N_det_generators)) zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_push = new_zmq_push_socket(thread) call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) @@ -101,7 +101,7 @@ subroutine push_pt2_results(zmq_socket_push, N, index, pt2_detail, task_id, ntas implicit none integer(ZMQ_PTR), intent(in) :: zmq_socket_push - double precision, intent(in) :: pt2_detail(N_states, N_det) + double precision, intent(in) :: pt2_detail(N_states, N_det_generators) integer, intent(in) :: ntask, N, index, task_id(*) integer :: rc @@ -133,7 +133,7 @@ subroutine pull_pt2_results(zmq_socket_pull, N, index, pt2_detail, task_id, ntas use selection_types implicit none integer(ZMQ_PTR), intent(in) :: zmq_socket_pull - double precision, intent(inout) :: pt2_detail(N_states, N_det) + double precision, intent(inout) :: pt2_detail(N_states, N_det_generators) integer, intent(out) :: index integer, intent(out) :: N, ntask, task_id(*) integer :: rc, rn, i @@ -150,18 +150,22 @@ subroutine pull_pt2_results(zmq_socket_pull, N, index, pt2_detail, task_id, ntas rc = f77_zmq_recv( zmq_socket_pull, ntask, 4, 0) if(rc /= 4) stop "pull" - rc = f77_zmq_recv( zmq_socket_pull, task_id(1), ntask*4, 0) + rc = f77_zmq_recv( zmq_socket_pull, task_id, ntask*4, 0) if(rc /= 4*ntask) stop "pull" ! Activate is zmq_socket_pull is a REP rc = f77_zmq_send( zmq_socket_pull, 'ok', 2, 0) + + do i=N+1,N_det_generators + pt2_detail(1:N_states,i) = 0.d0 + enddo end subroutine -BEGIN_PROVIDER [ double precision, pt2_workload, (N_det) ] +BEGIN_PROVIDER [ double precision, pt2_workload, (N_det_generators) ] integer :: i - do i=1,N_det - pt2_workload(:) = dfloat(N_det - i + 1)**2 + do i=1,N_det_generators + pt2_workload(i) = dfloat(N_det_generators - i + 1)**2 end do pt2_workload = pt2_workload / sum(pt2_workload) END_PROVIDER diff --git a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f index 59b2ba1f..85b52c30 100644 --- a/plugins/Full_CI_ZMQ/run_selection_slave.irp.f +++ b/plugins/Full_CI_ZMQ/run_selection_slave.irp.f @@ -26,7 +26,6 @@ subroutine run_selection_slave(thread,iproc,energy) call connect_to_taskserver(zmq_to_qp_run_socket,worker_id,thread) if(worker_id == -1) then print *, "WORKER -1" - !call disconnect_from_taskserver(zmq_to_qp_run_socket,zmq_socket_push,worker_id) call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) call end_zmq_push_socket(zmq_socket_push,thread) return diff --git a/plugins/Full_CI_ZMQ/selection.irp.f b/plugins/Full_CI_ZMQ/selection.irp.f index 43f43211..6fd4fd5e 100644 --- a/plugins/Full_CI_ZMQ/selection.irp.f +++ b/plugins/Full_CI_ZMQ/selection.irp.f @@ -1110,3 +1110,1115 @@ subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) enddo end +======= +use bitmasks + +BEGIN_PROVIDER [ integer, fragment_count ] + implicit none + BEGIN_DOC + ! Number of fragments for the deterministic part + END_DOC + fragment_count = (elec_alpha_num-n_core_orb)**2 +END_PROVIDER + + +double precision function integral8(i,j,k,l) + implicit none + + integer, intent(in) :: i,j,k,l + double precision, external :: get_mo_bielec_integral + integer :: ii + ii = l-mo_integrals_cache_min + ii = ior(ii, k-mo_integrals_cache_min) + ii = ior(ii, j-mo_integrals_cache_min) + ii = ior(ii, i-mo_integrals_cache_min) + if (iand(ii, -64) /= 0) then + integral8 = get_mo_bielec_integral(i,j,k,l,mo_integrals_map) + else + ii = l-mo_integrals_cache_min + ii = ior( ishft(ii,6), k-mo_integrals_cache_min) + ii = ior( ishft(ii,6), j-mo_integrals_cache_min) + ii = ior( ishft(ii,6), i-mo_integrals_cache_min) + integral8 = mo_integrals_cache(ii) + endif +end function + + +BEGIN_PROVIDER [ integer(1), psi_phasemask, (N_int*bit_kind_size, 2, N_det)] + use bitmasks + implicit none + + integer :: i + do i=1, N_det + call get_mask_phase(psi_det_sorted(1,1,i), psi_phasemask(1,1,i)) + end do +END_PROVIDER + + +subroutine assert(cond, msg) + character(*), intent(in) :: msg + logical, intent(in) :: cond + + if(.not. cond) then + print *, "assert failed: "//msg + stop + end if +end + + +subroutine get_mask_phase(det, phasemask) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: det(N_int, 2) + integer(1), intent(out) :: phasemask(2,N_int*bit_kind_size) + integer :: s, ni, i + logical :: change + + phasemask = 0_1 + do s=1,2 + change = .false. + do ni=1,N_int + do i=0,bit_kind_size-1 + if(BTEST(det(ni, s), i)) change = .not. change + if(change) phasemask(s, (ni-1)*bit_kind_size + i + 1) = 1_1 + end do + end do + end do +end + + +subroutine select_connected(i_generator,E0,pt2,b,subset) + use bitmasks + use selection_types + implicit none + integer, intent(in) :: i_generator, subset + type(selection_buffer), intent(inout) :: b + double precision, intent(inout) :: pt2(N_states) + integer :: k,l + double precision, intent(in) :: E0(N_states) + + integer(bit_kind) :: hole_mask(N_int,2), particle_mask(N_int,2) + double precision :: fock_diag_tmp(2,mo_tot_num+1) + + call build_fock_tmp(fock_diag_tmp,psi_det_generators(1,1,i_generator),N_int) + + do l=1,N_generators_bitmask + do k=1,N_int + hole_mask(k,1) = iand(generators_bitmask(k,1,s_hole,l), psi_det_generators(k,1,i_generator)) + hole_mask(k,2) = iand(generators_bitmask(k,2,s_hole,l), psi_det_generators(k,2,i_generator)) + particle_mask(k,1) = iand(generators_bitmask(k,1,s_part,l), not(psi_det_generators(k,1,i_generator)) ) + particle_mask(k,2) = iand(generators_bitmask(k,2,s_part,l), not(psi_det_generators(k,2,i_generator)) ) + + enddo + call select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,b,subset) + enddo +end + + +double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2) + use bitmasks + implicit none + + integer(1), intent(in) :: phasemask(2,*) + integer, intent(in) :: s1, s2, h1, h2, p1, p2 + logical :: change + integer(1) :: np1 + integer :: np + double precision, save :: res(0:1) = (/1d0, -1d0/) + + np1 = phasemask(s1,h1) + phasemask(s1,p1) + phasemask(s2,h2) + phasemask(s2,p2) + np = np1 + if(p1 < h1) np = np + 1 + if(p2 < h2) np = np + 1 + + if(s1 == s2 .and. max(h1, p1) > min(h2, p2)) np = np + 1 + get_phase_bi = res(iand(np,1)) +end + + + +subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: vect(N_states, mo_tot_num) + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i, j, h1, h2, p1, p2, sfix, hfix, pfix, hmob, pmob, puti + double precision :: hij + double precision, external :: get_phase_bi, integral8 + + integer, parameter :: turn3_2(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + integer, parameter :: turn2(2) = (/2,1/) + + if(h(0,sp) == 2) then + h1 = h(1, sp) + h2 = h(2, sp) + do i=1,3 + puti = p(i, sp) + if(bannedOrb(puti)) cycle + p1 = p(turn3_2(1,i), sp) + p2 = p(turn3_2(2,i), sp) + hij = integral8(p1, p2, h1, h2) - integral8(p2, p1, h1, h2) + hij *= get_phase_bi(phasemask, sp, sp, h1, p1, h2, p2) + vect(:, puti) += hij * coefs + end do + else if(h(0,sp) == 1) then + sfix = turn2(sp) + hfix = h(1,sfix) + pfix = p(1,sfix) + hmob = h(1,sp) + do j=1,2 + puti = p(j, sp) + if(bannedOrb(puti)) cycle + pmob = p(turn2(j), sp) + hij = integral8(pfix, pmob, hfix, hmob) + hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix) + vect(:, puti) += hij * coefs + end do + else + puti = p(1,sp) + if(.not. bannedOrb(puti)) then + sfix = turn2(sp) + p1 = p(1,sfix) + p2 = p(2,sfix) + h1 = h(1,sfix) + h2 = h(2,sfix) + hij = (integral8(p1,p2,h1,h2) - integral8(p2,p1,h1,h2)) + hij *= get_phase_bi(phasemask, sfix, sfix, h1, p1, h2, p2) + vect(:, puti) += hij * coefs + end if + end if +end + + + +subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: vect(N_states, mo_tot_num) + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i, hole, p1, p2, sh + logical :: ok, lbanned(mo_tot_num) + integer(bit_kind) :: det(N_int, 2) + double precision :: hij + double precision, external :: get_phase_bi, integral8 + + lbanned = bannedOrb + sh = 1 + if(h(0,2) == 1) sh = 2 + hole = h(1, sh) + lbanned(p(1,sp)) = .true. + if(p(0,sp) == 2) lbanned(p(2,sp)) = .true. + !print *, "SPm1", sp, sh + + p1 = p(1, sp) + + if(sp == sh) then + p2 = p(2, sp) + lbanned(p2) = .true. + + do i=1,hole-1 + if(lbanned(i)) cycle + hij = (integral8(p1, p2, i, hole) - integral8(p2, p1, i, hole)) + hij *= get_phase_bi(phasemask, sp, sp, i, p1, hole, p2) + vect(:,i) += hij * coefs + end do + do i=hole+1,mo_tot_num + if(lbanned(i)) cycle + hij = (integral8(p1, p2, hole, i) - integral8(p2, p1, hole, i)) + hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2) + vect(:,i) += hij * coefs + end do + + call apply_particle(mask, sp, p2, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + vect(:, p2) += hij * coefs + else + p2 = p(1, sh) + do i=1,mo_tot_num + if(lbanned(i)) cycle + hij = integral8(p1, p2, i, hole) + hij *= get_phase_bi(phasemask, sp, sh, i, p1, hole, p2) + vect(:,i) += hij * coefs + end do + end if + + call apply_particle(mask, sp, p1, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + vect(:, p1) += hij * coefs +end + + +subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: vect(N_states, mo_tot_num) + integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) + integer :: i + logical :: ok, lbanned(mo_tot_num) + integer(bit_kind) :: det(N_int, 2) + double precision :: hij + + lbanned = bannedOrb + lbanned(p(1,sp)) = .true. + do i=1,mo_tot_num + if(lbanned(i)) cycle + call apply_particle(mask, sp, i, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + vect(:, i) += hij * coefs + end do +end + +subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf,subset) + use bitmasks + use selection_types + implicit none + + integer, intent(in) :: i_generator, subset + integer(bit_kind), intent(in) :: hole_mask(N_int,2), particle_mask(N_int,2) + double precision, intent(in) :: fock_diag_tmp(mo_tot_num) + double precision, intent(in) :: E0(N_states) + double precision, intent(inout) :: pt2(N_states) + type(selection_buffer), intent(inout) :: buf + + double precision :: mat(N_states, mo_tot_num, mo_tot_num) + integer :: h1,h2,s1,s2,s3,i1,i2,ib,sp,k,i,j,nt,ii + integer(bit_kind) :: hole(N_int,2), particle(N_int,2), mask(N_int, 2), pmask(N_int, 2) + logical :: fullMatch, ok + + integer(bit_kind) :: mobMask(N_int, 2), negMask(N_int, 2) + integer,allocatable :: preinteresting(:), prefullinteresting(:), interesting(:), fullinteresting(:) + integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :) + + logical :: monoAdo, monoBdo; + integer :: maskInd + + PROVIDE fragment_count + + monoAdo = .true. + monoBdo = .true. + + allocate(minilist(N_int, 2, N_det_selectors), fullminilist(N_int, 2, N_det)) + allocate(preinteresting(0:N_det_selectors), prefullinteresting(0:N_det), interesting(0:N_det_selectors), fullinteresting(0:N_det)) + + do k=1,N_int + hole (k,1) = iand(psi_det_generators(k,1,i_generator), hole_mask(k,1)) + hole (k,2) = iand(psi_det_generators(k,2,i_generator), hole_mask(k,2)) + particle(k,1) = iand(not(psi_det_generators(k,1,i_generator)), particle_mask(k,1)) + particle(k,2) = iand(not(psi_det_generators(k,2,i_generator)), particle_mask(k,2)) + enddo + + integer :: N_holes(2), N_particles(2) + integer :: hole_list(N_int*bit_kind_size,2) + integer :: particle_list(N_int*bit_kind_size,2) + + call bitstring_to_list_ab(hole , hole_list , N_holes , N_int) + call bitstring_to_list_ab(particle, particle_list, N_particles, N_int) + +! ! ====== +! ! If the subset doesn't exist, return +! logical :: will_compute +! will_compute = subset == 0 +! +! if (.not.will_compute) then +! maskInd = N_holes(1)*N_holes(2) + N_holes(2)*((N_holes(2)-1)/2) + N_holes(1)*((N_holes(1)-1)/2) +! will_compute = (maskInd >= subset) +! if (.not.will_compute) then +! return +! endif +! endif +! ! ====== + + + integer(bit_kind), allocatable:: preinteresting_det(:,:,:) + allocate (preinteresting_det(N_int,2,N_det)) + + preinteresting(0) = 0 + prefullinteresting(0) = 0 + + do i=1,N_int + negMask(i,1) = not(psi_det_generators(i,1,i_generator)) + negMask(i,2) = not(psi_det_generators(i,2,i_generator)) + end do + + do i=1,N_det + mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt <= 4) then + if(i <= N_det_selectors) then + preinteresting(0) += 1 + preinteresting(preinteresting(0)) = i + do j=1,N_int + preinteresting_det(j,1,preinteresting(0)) = psi_det_sorted(j,1,i) + preinteresting_det(j,2,preinteresting(0)) = psi_det_sorted(j,2,i) + enddo + else if(nt <= 2) then + prefullinteresting(0) += 1 + prefullinteresting(prefullinteresting(0)) = i + end if + end if + end do + + + maskInd = -1 + integer :: nb_count + do s1=1,2 + do i1=N_holes(s1),1,-1 ! Generate low excitations first + + h1 = hole_list(i1,s1) + call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int) + + negMask = not(pmask) + + interesting(0) = 0 + fullinteresting(0) = 0 + + do ii=1,preinteresting(0) + i = preinteresting(ii) + mobMask(1,1) = iand(negMask(1,1), preinteresting_det(1,1,ii)) + mobMask(1,2) = iand(negMask(1,2), preinteresting_det(1,2,ii)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), preinteresting_det(j,1,ii)) + mobMask(j,2) = iand(negMask(j,2), preinteresting_det(j,2,ii)) + nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt <= 4) then + interesting(0) += 1 + interesting(interesting(0)) = i + minilist(1,1,interesting(0)) = preinteresting_det(1,1,ii) + minilist(1,2,interesting(0)) = preinteresting_det(1,2,ii) + do j=2,N_int + minilist(j,1,interesting(0)) = preinteresting_det(j,1,ii) + minilist(j,2,interesting(0)) = preinteresting_det(j,2,ii) + enddo + if(nt <= 2) then + fullinteresting(0) += 1 + fullinteresting(fullinteresting(0)) = i + fullminilist(1,1,fullinteresting(0)) = preinteresting_det(1,1,ii) + fullminilist(1,2,fullinteresting(0)) = preinteresting_det(1,2,ii) + do j=2,N_int + fullminilist(j,1,fullinteresting(0)) = preinteresting_det(j,1,ii) + fullminilist(j,2,fullinteresting(0)) = preinteresting_det(j,2,ii) + enddo + end if + end if + end do + + do ii=1,prefullinteresting(0) + i = prefullinteresting(ii) + nt = 0 + mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(j,2,i)) + nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt <= 2) then + fullinteresting(0) += 1 + fullinteresting(fullinteresting(0)) = i + fullminilist(1,1,fullinteresting(0)) = psi_det_sorted(1,1,i) + fullminilist(1,2,fullinteresting(0)) = psi_det_sorted(1,2,i) + do j=2,N_int + fullminilist(j,1,fullinteresting(0)) = psi_det_sorted(j,1,i) + fullminilist(j,2,fullinteresting(0)) = psi_det_sorted(j,2,i) + enddo + end if + end do + + + + do s2=s1,2 + sp = s1 + + if(s1 /= s2) sp = 3 + + ib = 1 + if(s1 == s2) ib = i1+1 + monoAdo = .true. + do i2=N_holes(s2),ib,-1 ! Generate low excitations first + logical :: banned(mo_tot_num, mo_tot_num,2) + logical :: bannedOrb(mo_tot_num, 2) + + h2 = hole_list(i2,s2) + call apply_hole(pmask, s2,h2, mask, ok, N_int) + banned = .false. + do j=1,mo_tot_num + bannedOrb(j, 1) = .true. + bannedOrb(j, 2) = .true. + enddo + do s3=1,2 + do i=1,N_particles(s3) + bannedOrb(particle_list(i,s3), s3) = .false. + enddo + enddo + if(s1 /= s2) then + if(monoBdo) then + bannedOrb(h1,s1) = .false. + end if + if(monoAdo) then + bannedOrb(h2,s2) = .false. + monoAdo = .false. + end if + end if + + maskInd += 1 + if(subset == 0 .or. mod(maskInd, fragment_count) == (subset-1)) then + + call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting) + if(fullMatch) cycle + + mat = 0d0 + call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting) + + call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf) + end if + enddo + if(s1 /= s2) monoBdo = .false. + enddo + enddo + enddo +end + + + +subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf) + use bitmasks + use selection_types + implicit none + + integer, intent(in) :: i_generator, sp, h1, h2 + double precision, intent(in) :: mat(N_states, mo_tot_num, mo_tot_num) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) + double precision, intent(in) :: fock_diag_tmp(mo_tot_num) + double precision, intent(in) :: E0(N_states) + double precision, intent(inout) :: pt2(N_states) + type(selection_buffer), intent(inout) :: buf + logical :: ok + integer :: s1, s2, p1, p2, ib, j, istate + integer(bit_kind) :: mask(N_int, 2), det(N_int, 2) + double precision :: e_pert, delta_E, val, Hii, max_e_pert,tmp + double precision, external :: diag_H_mat_elem_fock + + logical, external :: detEq + + + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int) + + do p1=1,mo_tot_num + if(bannedOrb(p1, s1)) cycle + ib = 1 + if(sp /= 3) ib = p1+1 + do p2=ib,mo_tot_num + if(bannedOrb(p2, s2)) cycle + if(banned(p1,p2)) cycle + if(mat(1, p1, p2) == 0d0) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + + Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int) + max_e_pert = 0d0 + + do istate=1,N_states + delta_E = E0(istate) - Hii + val = mat(istate, p1, p2) + mat(istate, p1, p2) + tmp = dsqrt(delta_E * delta_E + val * val) + if (delta_E < 0.d0) then + tmp = -tmp + endif + e_pert = 0.5d0 * ( tmp - delta_E) + pt2(istate) = pt2(istate) + e_pert + max_e_pert = min(e_pert,max_e_pert) +! ci(istate) = e_pert / mat(istate, p1, p2) + end do + + if(dabs(max_e_pert) > buf%mini) then + call add_to_selection_buffer(buf, det, max_e_pert) + end if + end do + end do +end + + +subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat, interesting) + use bitmasks + implicit none + + integer, intent(in) :: sp, i_gen, N_sel + integer, intent(in) :: interesting(0:N_sel) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) + logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + + integer :: i, ii, j, k, l, h(0:2,2), p(0:4,2), nt + integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) +! logical :: bandon +! +! bandon = .false. + PROVIDE psi_phasemask psi_selectors_coef_transp + mat = 0d0 + + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + do i=1, N_sel ! interesting(0) + !i = interesting(ii) + if (interesting(i) < 0) then + stop 'prefetch interesting(i)' + endif + + + mobMask(1,1) = iand(negMask(1,1), det(1,1,i)) + mobMask(1,2) = iand(negMask(1,2), det(1,2,i)) + nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) + + if(nt > 4) cycle + + do j=2,N_int + mobMask(j,1) = iand(negMask(j,1), det(j,1,i)) + mobMask(j,2) = iand(negMask(j,2), det(j,2,i)) + nt = nt + popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) + end do + + if(nt > 4) cycle + + if (interesting(i) == i_gen) then + if(sp == 3) then + do j=1,mo_tot_num + do k=1,mo_tot_num + banned(j,k,2) = banned(k,j,1) + enddo + enddo + else + do k=1,mo_tot_num + do l=k+1,mo_tot_num + banned(l,k,1) = banned(k,l,1) + end do + end do + end if + end if + + call bitstring_to_list_in_selection(mobMask(1,1), p(1,1), p(0,1), N_int) + call bitstring_to_list_in_selection(mobMask(1,2), p(1,2), p(0,2), N_int) + + perMask(1,1) = iand(mask(1,1), not(det(1,1,i))) + perMask(1,2) = iand(mask(1,2), not(det(1,2,i))) + do j=2,N_int + perMask(j,1) = iand(mask(j,1), not(det(j,1,i))) + perMask(j,2) = iand(mask(j,2), not(det(j,2,i))) + end do + + call bitstring_to_list_in_selection(perMask(1,1), h(1,1), h(0,1), N_int) + call bitstring_to_list_in_selection(perMask(1,2), h(1,2), h(0,2), N_int) + + if (interesting(i) >= i_gen) then + if(nt == 4) then + call get_d2(det(1,1,i), psi_phasemask(1,1,interesting(i)), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else if(nt == 3) then + call get_d1(det(1,1,i), psi_phasemask(1,1,interesting(i)), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + else + call get_d0(det(1,1,i), psi_phasemask(1,1,interesting(i)), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, interesting(i))) + end if + else + if(nt == 4) call past_d2(banned, p, sp) + if(nt == 3) call past_d1(bannedOrb, p) + end if + end do +end + + +subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + double precision, external :: get_phase_bi, integral8 + + integer :: i, j, tip, ma, mi, puti, putj + integer :: h1, h2, p1, p2, i1, i2 + double precision :: hij, phase + + integer, parameter:: turn2d(2,3,4) = reshape((/0,0, 0,0, 0,0, 3,4, 0,0, 0,0, 2,4, 1,4, 0,0, 2,3, 1,3, 1,2 /), (/2,3,4/)) + integer, parameter :: turn2(2) = (/2, 1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + bant = 1 + + tip = p(0,1) * p(0,2) + + ma = sp + if(p(0,1) > p(0,2)) ma = 1 + if(p(0,1) < p(0,2)) ma = 2 + mi = mod(ma, 2) + 1 + + if(sp == 3) then + if(ma == 2) bant = 2 + + if(tip == 3) then + puti = p(1, mi) + do i = 1, 3 + putj = p(i, ma) + if(banned(putj,puti,bant)) cycle + i1 = turn3(1,i) + i2 = turn3(2,i) + p1 = p(i1, ma) + p2 = p(i2, ma) + h1 = h(1, ma) + h2 = h(2, ma) + + hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) + if(ma == 1) then + mat(:, putj, puti) += coefs * hij + else + mat(:, puti, putj) += coefs * hij + end if + end do + else + h1 = h(1,1) + h2 = h(1,2) + do j = 1,2 + putj = p(j, 2) + p2 = p(turn2(j), 2) + do i = 1,2 + puti = p(i, 1) + + if(banned(puti,putj,bant)) cycle + p1 = p(turn2(i), 1) + + hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) + mat(:, puti, putj) += coefs * hij + end do + end do + end if + + else + if(tip == 0) then + h1 = h(1, ma) + h2 = h(2, ma) + do i=1,3 + puti = p(i, ma) + do j=i+1,4 + putj = p(j, ma) + if(banned(puti,putj,1)) cycle + + i1 = turn2d(1, i, j) + i2 = turn2d(2, i, j) + p1 = p(i1, ma) + p2 = p(i2, ma) + hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) + mat(:, puti, putj) += coefs * hij + end do + end do + else if(tip == 3) then + h1 = h(1, mi) + h2 = h(1, ma) + p1 = p(1, mi) + do i=1,3 + puti = p(turn3(1,i), ma) + putj = p(turn3(2,i), ma) + if(banned(puti,putj,1)) cycle + p2 = p(i, ma) + + hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) + mat(:, min(puti, putj), max(puti, putj)) += coefs * hij + end do + else ! tip == 4 + puti = p(1, sp) + putj = p(2, sp) + if(.not. banned(puti,putj,1)) then + p1 = p(1, mi) + p2 = p(2, mi) + h1 = h(1, mi) + h2 = h(2, mi) + hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) + mat(:, puti, putj) += coefs * hij + end if + end if + end if +end + + +subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2) + integer(1),intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) + integer(bit_kind) :: det(N_int, 2) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) + double precision, external :: get_phase_bi, integral8 + + logical :: lbanned(mo_tot_num, 2), ok + integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j, hfix, pfix, h1, h2, p1, p2, ib + + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + integer, parameter :: turn2(2) = (/2,1/) + integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) + + integer :: bant + + + lbanned = bannedOrb + + do i=1, p(0,1) + lbanned(p(i,1), 1) = .true. + end do + do i=1, p(0,2) + lbanned(p(i,2), 2) = .true. + end do + + ma = 1 + if(p(0,2) >= 2) ma = 2 + mi = turn2(ma) + + bant = 1 + + if(sp == 3) then + !move MA + if(ma == 2) bant = 2 + puti = p(1,mi) + hfix = h(1,ma) + p1 = p(1,ma) + p2 = p(2,ma) + if(.not. bannedOrb(puti, mi)) then + tmp_row = 0d0 + do putj=1, hfix-1 + if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle + hij = (integral8(p1, p2, putj, hfix)-integral8(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) + tmp_row(1:N_states,putj) += hij * coefs(1:N_states) + end do + do putj=hfix+1, mo_tot_num + if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle + hij = (integral8(p1, p2, hfix, putj)-integral8(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) + tmp_row(1:N_states,putj) += hij * coefs(1:N_states) + end do + + if(ma == 1) then + mat(1:N_states,1:mo_tot_num,puti) += tmp_row(1:N_states,1:mo_tot_num) + else + mat(1:N_states,puti,1:mo_tot_num) += tmp_row(1:N_states,1:mo_tot_num) + end if + end if + + !MOVE MI + pfix = p(1,mi) + tmp_row = 0d0 + tmp_row2 = 0d0 + do puti=1,mo_tot_num + if(lbanned(puti,mi)) cycle + !p1 fixed + putj = p1 + if(.not. banned(putj,puti,bant)) then + hij = integral8(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix) + tmp_row(:,puti) += hij * coefs + end if + + putj = p2 + if(.not. banned(putj,puti,bant)) then + hij = integral8(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix) + tmp_row2(:,puti) += hij * coefs + end if + end do + + if(mi == 1) then + mat(:,:,p1) += tmp_row(:,:) + mat(:,:,p2) += tmp_row2(:,:) + else + mat(:,p1,:) += tmp_row(:,:) + mat(:,p2,:) += tmp_row2(:,:) + end if + else + if(p(0,ma) == 3) then + do i=1,3 + hfix = h(1,ma) + puti = p(i, ma) + p1 = p(turn3(1,i), ma) + p2 = p(turn3(2,i), ma) + tmp_row = 0d0 + do putj=1,hfix-1 + if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle + hij = (integral8(p1, p2, putj, hfix)-integral8(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) + tmp_row(:,putj) += hij * coefs + end do + do putj=hfix+1,mo_tot_num + if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle + hij = (integral8(p1, p2, hfix, putj)-integral8(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) + tmp_row(:,putj) += hij * coefs + end do + + mat(:, :puti-1, puti) += tmp_row(:,:puti-1) + mat(:, puti, puti:) += tmp_row(:,puti:) + end do + else + hfix = h(1,mi) + pfix = p(1,mi) + p1 = p(1,ma) + p2 = p(2,ma) + tmp_row = 0d0 + tmp_row2 = 0d0 + do puti=1,mo_tot_num + if(lbanned(puti,ma)) cycle + putj = p2 + if(.not. banned(puti,putj,1)) then + hij = integral8(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1) + tmp_row(:,puti) += hij * coefs + end if + + putj = p1 + if(.not. banned(puti,putj,1)) then + hij = integral8(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2) + tmp_row2(:,puti) += hij * coefs + end if + end do + mat(:,:p2-1,p2) += tmp_row(:,:p2-1) + mat(:,p2,p2:) += tmp_row(:,p2:) + mat(:,:p1-1,p1) += tmp_row2(:,:p1-1) + mat(:,p1,p1:) += tmp_row2(:,p1:) + end if + end if + + !! MONO + if(sp == 3) then + s1 = 1 + s2 = 2 + else + s1 = sp + s2 = sp + end if + + do i1=1,p(0,s1) + ib = 1 + if(s1 == s2) ib = i1+1 + do i2=ib,p(0,s2) + p1 = p(i1,s1) + p2 = p(i2,s2) + if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) cycle + call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + mat(:, p1, p2) += coefs * hij + end do + end do +end + + + + +subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs) + use bitmasks + implicit none + + integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2) + integer(1), intent(in) :: phasemask(2,N_int*bit_kind_size) + logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2) + integer(bit_kind) :: det(N_int, 2) + double precision, intent(in) :: coefs(N_states) + double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) + integer, intent(in) :: h(0:2,2), p(0:4,2), sp + + integer :: i, j, s, h1, h2, p1, p2, puti, putj + double precision :: hij, phase + double precision, external :: get_phase_bi, integral8 + logical :: ok + + integer :: bant + bant = 1 + + + if(sp == 3) then ! AB + h1 = p(1,1) + h2 = p(1,2) + do p1=1, mo_tot_num + if(bannedOrb(p1, 1)) cycle + do p2=1, mo_tot_num + if(bannedOrb(p2,2)) cycle + if(banned(p1, p2, bant)) cycle ! rentable? + if(p1 == h1 .or. p2 == h2) then + call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + else + phase = get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) + hij = integral8(p1, p2, h1, h2) * phase + end if + mat(:, p1, p2) += coefs(:) * hij + end do + end do + else ! AA BB + p1 = p(1,sp) + p2 = p(2,sp) + do puti=1, mo_tot_num + if(bannedOrb(puti, sp)) cycle + do putj=puti+1, mo_tot_num + if(bannedOrb(putj, sp)) cycle + if(banned(puti, putj, bant)) cycle ! rentable? + if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then + call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) + call i_h_j(gen, det, N_int, hij) + else + hij = (integral8(p1, p2, puti, putj) - integral8(p2, p1, puti, putj))* get_phase_bi(phasemask, sp, sp, puti, p1 , putj, p2) + end if + mat(:, puti, putj) += coefs(:) * hij + end do + end do + end if +end + + +subroutine past_d1(bannedOrb, p) + use bitmasks + implicit none + + logical, intent(inout) :: bannedOrb(mo_tot_num, 2) + integer, intent(in) :: p(0:4, 2) + integer :: i,s + + do s = 1, 2 + do i = 1, p(0, s) + bannedOrb(p(i, s), s) = .true. + end do + end do +end + + +subroutine past_d2(banned, p, sp) + use bitmasks + implicit none + + logical, intent(inout) :: banned(mo_tot_num, mo_tot_num) + integer, intent(in) :: p(0:4, 2), sp + integer :: i,j + + if(sp == 3) then + do i=1,p(0,1) + do j=1,p(0,2) + banned(p(i,1), p(j,2)) = .true. + end do + end do + else + do i=1,p(0, sp) + do j=1,i-1 + banned(p(j,sp), p(i,sp)) = .true. + banned(p(i,sp), p(j,sp)) = .true. + end do + end do + end if +end + + + +subroutine spot_isinwf(mask, det, i_gen, N, banned, fullMatch, interesting) + use bitmasks + implicit none + + integer, intent(in) :: i_gen, N + integer, intent(in) :: interesting(0:N) + integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N) + logical, intent(inout) :: banned(mo_tot_num, mo_tot_num) + logical, intent(out) :: fullMatch + + + integer :: i, j, na, nb, list(3) + integer(bit_kind) :: myMask(N_int, 2), negMask(N_int, 2) + + fullMatch = .false. + + do i=1,N_int + negMask(i,1) = not(mask(i,1)) + negMask(i,2) = not(mask(i,2)) + end do + + genl : do i=1, N + do j=1, N_int + if(iand(det(j,1,i), mask(j,1)) /= mask(j, 1)) cycle genl + if(iand(det(j,2,i), mask(j,2)) /= mask(j, 2)) cycle genl + end do + + if(interesting(i) < i_gen) then + fullMatch = .true. + return + end if + + do j=1, N_int + myMask(j, 1) = iand(det(j, 1, i), negMask(j, 1)) + myMask(j, 2) = iand(det(j, 2, i), negMask(j, 2)) + end do + + call bitstring_to_list_in_selection(myMask(1,1), list(1), na, N_int) + call bitstring_to_list_in_selection(myMask(1,2), list(na+1), nb, N_int) + banned(list(1), list(2)) = .true. + end do genl +end + + +subroutine bitstring_to_list_in_selection( string, list, n_elements, Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Gives the inidices(+1) of the bits set to 1 in the bit string + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: string(Nint) + integer, intent(out) :: list(Nint*bit_kind_size) + integer, intent(out) :: n_elements + + integer :: i, ishift + integer(bit_kind) :: l + + n_elements = 0 + ishift = 2 + do i=1,Nint + l = string(i) + do while (l /= 0_bit_kind) + n_elements = n_elements+1 + list(n_elements) = ishift+popcnt(l-1_bit_kind) - popcnt(l) + l = iand(l,l-1_bit_kind) + enddo + ishift = ishift + bit_kind_size + enddo + +end diff --git a/plugins/Full_CI_ZMQ/selection_buffer.irp.f b/plugins/Full_CI_ZMQ/selection_buffer.irp.f index d296b399..8a47cb9d 100644 --- a/plugins/Full_CI_ZMQ/selection_buffer.irp.f +++ b/plugins/Full_CI_ZMQ/selection_buffer.irp.f @@ -41,31 +41,33 @@ subroutine sort_selection_buffer(b) implicit none type(selection_buffer), intent(inout) :: b - double precision, allocatable :: vals(:), absval(:) + double precision, allocatable:: absval(:) integer, allocatable :: iorder(:) - integer(bit_kind), allocatable :: detmp(:,:,:) + double precision, pointer :: vals(:) + integer(bit_kind), pointer :: detmp(:,:,:) integer :: i, nmwen logical, external :: detEq nmwen = min(b%N, b%cur) - allocate(iorder(b%cur), detmp(N_int, 2, nmwen), absval(b%cur), vals(nmwen)) + allocate(iorder(b%cur), detmp(N_int, 2, size(b%det,3)), absval(b%cur), vals(size(b%val))) absval = -dabs(b%val(:b%cur)) do i=1,b%cur iorder(i) = i end do - call dsort(absval, iorder, b%cur) - + ! Optimal for almost sorted data + call insertion_dsort(absval, iorder, b%cur) do i=1, nmwen detmp(1:N_int,1,i) = b%det(1:N_int,1,iorder(i)) detmp(1:N_int,2,i) = b%det(1:N_int,2,iorder(i)) vals(i) = b%val(iorder(i)) end do - b%det = 0_bit_kind - b%val = 0d0 - b%det(1:N_int,1,1:nmwen) = detmp(1:N_int,1,1:nmwen) - b%det(1:N_int,2,1:nmwen) = detmp(1:N_int,2,1:nmwen) - b%val(1:nmwen) = vals(1:nmwen) + do i=nmwen+1, size(vals) + vals(i) = 0.d0 + enddo + deallocate(b%det, b%val) + b%det => detmp + b%val => vals b%mini = max(b%mini,dabs(b%val(b%N))) b%cur = nmwen end subroutine diff --git a/plugins/Full_CI_ZMQ/selection_types.f90 b/plugins/Full_CI_ZMQ/selection_types.f90 index 9506629c..29e48524 100644 --- a/plugins/Full_CI_ZMQ/selection_types.f90 +++ b/plugins/Full_CI_ZMQ/selection_types.f90 @@ -1,9 +1,9 @@ module selection_types type selection_buffer integer :: N, cur - integer(8), allocatable :: det(:,:,:) - double precision, allocatable :: val(:) - double precision :: mini + integer(8) , pointer :: det(:,:,:) + double precision, pointer :: val(:) + double precision :: mini endtype end module diff --git a/plugins/Full_CI_ZMQ/zmq_selection.irp.f b/plugins/Full_CI_ZMQ/zmq_selection.irp.f index 8aaddc19..62703a43 100644 --- a/plugins/Full_CI_ZMQ/zmq_selection.irp.f +++ b/plugins/Full_CI_ZMQ/zmq_selection.irp.f @@ -10,26 +10,38 @@ subroutine ZMQ_selection(N_in, pt2) integer :: i, N integer, external :: omp_get_thread_num double precision, intent(out) :: pt2(N_states) + integer, parameter :: maxtasks=10000 PROVIDE fragment_count + N = max(N_in,1) if (.True.) then PROVIDE pt2_e0_denominator - N = max(N_in,1) provide nproc call new_parallel_job(zmq_to_qp_run_socket,"selection") call zmq_put_psi(zmq_to_qp_run_socket,1,pt2_e0_denominator,size(pt2_e0_denominator)) - call zmq_set_running(zmq_to_qp_run_socket) call create_selection_buffer(N, N*2, b) endif - character(len=:), allocatable :: task - task = repeat(' ',20*N_det_generators) + character*(20*maxtasks) :: task + task = ' ' + + integer :: k + k=0 do i= 1, N_det_generators - write(task(20*(i-1)+1:20*i),'(I9,X,I9,''|'')') i, N + k = k+1 + write(task(20*(k-1)+1:20*k),'(I9,1X,I9,''|'')') i, N + k = k+20 + if (k>20*maxtasks) then + k=0 + call add_task_to_taskserver(zmq_to_qp_run_socket,task) + endif end do - call add_task_to_taskserver(zmq_to_qp_run_socket,task) + if (k > 0) then + call add_task_to_taskserver(zmq_to_qp_run_socket,task) + endif + call zmq_set_running(zmq_to_qp_run_socket) !$OMP PARALLEL DEFAULT(shared) SHARED(b, pt2) PRIVATE(i) NUM_THREADS(nproc+1) i = omp_get_thread_num() @@ -48,6 +60,7 @@ subroutine ZMQ_selection(N_in, pt2) endif call save_wavefunction endif + end subroutine @@ -83,7 +96,7 @@ subroutine selection_collector(b, pt2) real :: time, time0 zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() zmq_socket_pull = new_zmq_pull_socket() - allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det)) + allocate(val(b%N), det(N_int, 2, b%N), task_id(N_det_generators)) done = 0 more = 1 pt2(:) = 0d0 diff --git a/plugins/MRCC_Utils/amplitudes.irp.f b/plugins/MRCC_Utils/amplitudes.irp.f index f9cb51ad..ccbe700d 100644 --- a/plugins/MRCC_Utils/amplitudes.irp.f +++ b/plugins/MRCC_Utils/amplitudes.irp.f @@ -23,33 +23,39 @@ allocate(pathTo(N_det_non_ref)) pathTo(:) = 0 - is_active_exc(:) = .false. + is_active_exc(:) = .True. n_exc_active = 0 - do hh = 1, hh_shortcut(0) - do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 - do II = 1, N_det_ref +! do hh = 1, hh_shortcut(0) +! do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 +! do II = 1, N_det_ref +! +! call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int) +! if(.not. ok) cycle +! +! call apply_particle_local(myMask, pp_exists(1, pp), myDet, ok, N_int) +! if(.not. ok) cycle +! +! ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int) +! if(ind == -1) cycle +! +! logical, external :: is_a_two_holes_two_particles +! if (is_a_two_holes_two_particles(myDet)) then +! is_active_exc(pp) = .False. +! endif - call apply_hole_local(psi_ref(1,1,II), hh_exists(1, hh), myMask, ok, N_int) - if(.not. ok) cycle +! ind = psi_non_ref_sorted_idx(ind) +! if(pathTo(ind) == 0) then +! pathTo(ind) = pp +! else +! is_active_exc(pp) = .true. +! is_active_exc(pathTo(ind)) = .true. +! end if - call apply_particle_local(myMask, pp_exists(1, pp), myDet, ok, N_int) - if(.not. ok) cycle +! end do +! end do +! end do - ind = searchDet(psi_non_ref_sorted(1,1,1), myDet(1,1), N_det_non_ref, N_int) - if(ind == -1) cycle - - ind = psi_non_ref_sorted_idx(ind) - if(pathTo(ind) == 0) then - pathTo(ind) = pp - else - is_active_exc(pp) = .true. - is_active_exc(pathTo(ind)) = .true. - end if - end do - end do - end do -!is_active_exc=.true. do hh = 1, hh_shortcut(0) do pp = hh_shortcut(hh), hh_shortcut(hh+1)-1 if(is_active_exc(pp)) then @@ -66,6 +72,32 @@ END_PROVIDER +BEGIN_PROVIDER [ logical, has_a_unique_parent, (N_det_non_ref) ] + implicit none + BEGIN_DOC + ! True if the determinant in the non-reference has a unique parent + END_DOC + integer :: i,j,n + integer :: degree + do j=1,N_det_non_ref + has_a_unique_parent(j) = .True. + n=0 + do i=1,N_det_ref + call get_excitation_degree(psi_ref(1,1,i), psi_non_ref(1,1,j), degree, N_int) + if (degree < 2) then + n = n+1 + if (n > 1) then + has_a_unique_parent(j) = .False. + exit + endif + endif + enddo + enddo + +END_PROVIDER + + + BEGIN_PROVIDER [ integer, n_exc_active_sze ] implicit none BEGIN_DOC @@ -96,7 +128,7 @@ END_PROVIDER !$OMP active_excitation_to_determinants_val, active_excitation_to_determinants_idx)& !$OMP shared(hh_shortcut, psi_ref_coef, N_det_non_ref, psi_non_ref_sorted, & !$OMP psi_non_ref_sorted_idx, psi_ref, N_det_ref, N_states)& - !$OMP shared(is_active_exc, active_hh_idx, active_pp_idx, n_exc_active)& + !$OMP shared(active_hh_idx, active_pp_idx, n_exc_active)& !$OMP private(lref, pp, II, ok, myMask, myDet, ind, phase, wk, ppp, hh, s) allocate(lref(N_det_non_ref)) !$OMP DO schedule(dynamic) diff --git a/plugins/MRCC_Utils/mrcc_utils.irp.f b/plugins/MRCC_Utils/mrcc_utils.irp.f index 69e5a662..7ba210ca 100644 --- a/plugins/MRCC_Utils/mrcc_utils.irp.f +++ b/plugins/MRCC_Utils/mrcc_utils.irp.f @@ -351,11 +351,11 @@ logical function is_generable(det1, det2, Nint) integer, intent(in) :: Nint integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) integer :: degree, f, exc(0:2, 2, 2), t - integer*2 :: h1, h2, p1, p2, s1, s2 + integer :: h1, h2, p1, p2, s1, s2 integer, external :: searchExc logical, external :: excEq double precision :: phase - integer*2 :: tmp_array(4) + integer :: tmp_array(4) is_generable = .false. call get_excitation(det1, det2, exc, degree, phase, Nint) @@ -366,7 +366,7 @@ logical function is_generable(det1, det2, Nint) end if if(degree > 2) stop "?22??" - call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) if(degree == 1) then h2 = h1 @@ -454,7 +454,7 @@ integer function searchExc(excs, exc, n) use bitmasks integer, intent(in) :: n - integer*2,intent(in) :: excs(4,n), exc(4) + integer,intent(in) :: excs(4,n), exc(4) integer :: l, h, c integer, external :: excCmp logical, external :: excEq @@ -519,8 +519,8 @@ subroutine sort_exc(key, N_key) integer, intent(in) :: N_key - integer*2,intent(inout) :: key(4,N_key) - integer*2 :: tmp(4) + integer,intent(inout) :: key(4,N_key) + integer :: tmp(4) integer :: i,ni @@ -542,7 +542,7 @@ end subroutine logical function exc_inf(exc1, exc2) implicit none - integer*2,intent(in) :: exc1(4), exc2(4) + integer,intent(in) :: exc1(4), exc2(4) integer :: i exc_inf = .false. do i=1,4 @@ -564,9 +564,9 @@ subroutine tamise_exc(key, no, n, N_key) ! Uncodumented : TODO END_DOC integer,intent(in) :: no, n, N_key - integer*2,intent(inout) :: key(4, N_key) + integer,intent(inout) :: key(4, N_key) integer :: k,j - integer*2 :: tmp(4) + integer :: tmp(4) logical :: exc_inf integer :: ni @@ -595,8 +595,9 @@ end subroutine subroutine dec_exc(exc, h1, h2, p1, p2) implicit none - integer :: exc(0:2,2,2), s1, s2, degree - integer*2, intent(out) :: h1, h2, p1, p2 + integer, intent(in) :: exc(0:2,2,2) + integer, intent(out) :: h1, h2, p1, p2 + integer :: degree, s1, s2 degree = exc(0,1,1) + exc(0,1,2) @@ -607,7 +608,7 @@ subroutine dec_exc(exc, h1, h2, p1, p2) if(degree == 0) return - call decode_exc_int2(exc, degree, h1, p1, h2, p2, s1, s2) + call decode_exc(exc, degree, h1, p1, h2, p2, s1, s2) h1 += mo_tot_num * (s1-1) p1 += mo_tot_num * (s1-1) @@ -639,7 +640,7 @@ end subroutine &BEGIN_PROVIDER [ integer, N_ex_exists ] implicit none integer :: exc(0:2, 2, 2), degree, n, on, s, l, i - integer*2 :: h1, h2, p1, p2 + integer :: h1, h2, p1, p2 double precision :: phase logical,allocatable :: hh(:,:) , pp(:,:) @@ -739,12 +740,12 @@ END_PROVIDER double precision :: phase - double precision, allocatable :: rho_mrcc_init(:) + double precision, allocatable :: rho_mrcc_inact(:) integer :: a_coll, at_roww print *, "TI", hh_nex, N_det_non_ref - allocate(rho_mrcc_init(N_det_non_ref)) + allocate(rho_mrcc_inact(N_det_non_ref)) allocate(x_new(hh_nex)) allocate(x(hh_nex), AtB(hh_nex)) @@ -756,7 +757,7 @@ END_PROVIDER !$OMP private(at_row, a_col, i, j, r1, r2, wk, A_ind_mwen, A_val_mwen, a_coll, at_roww)& !$OMP shared(N_states,mrcc_col_shortcut, mrcc_N_col, AtB, mrcc_AtA_val, mrcc_AtA_ind, s, n_exc_active, active_pp_idx) - !$OMP DO schedule(dynamic, 100) + !$OMP DO schedule(static, 100) do at_roww = 1, n_exc_active ! hh_nex at_row = active_pp_idx(at_roww) do i=1,active_excitation_to_determinants_idx(0,at_roww) @@ -775,7 +776,7 @@ END_PROVIDER X(a_col) = AtB(a_col) end do - rho_mrcc_init = 0d0 + rho_mrcc_inact(:) = 0d0 allocate(lref(N_det_ref)) do hh = 1, hh_shortcut(0) @@ -799,19 +800,15 @@ END_PROVIDER X(pp) = AtB(pp) do II=1,N_det_ref if(lref(II) > 0) then - rho_mrcc_init(lref(II)) = psi_ref_coef(II,s) * X(pp) + rho_mrcc_inact(lref(II)) = psi_ref_coef(II,s) * X(pp) else if(lref(II) < 0) then - rho_mrcc_init(-lref(II)) = -psi_ref_coef(II,s) * X(pp) + rho_mrcc_inact(-lref(II)) = -psi_ref_coef(II,s) * X(pp) end if end do end do end do deallocate(lref) - do i=1,N_det_non_ref - rho_mrcc(i,s) = rho_mrcc_init(i) - enddo - x_new = x double precision :: factor, resold @@ -839,7 +836,10 @@ END_PROVIDER print *, k, res, 1.d0 - res/resold endif - if ( (res < 1d-10).or.(res/resold > 0.99d0) ) then + if ( res < 1d-10 ) then + exit + endif + if ( (res/resold > 0.99d0) ) then exit endif resold = res @@ -848,38 +848,60 @@ END_PROVIDER dIj_unique(1:size(X), s) = X(1:size(X)) print *, k, res, 1.d0 - res/resold - enddo - do s=1,N_states + do i=1,N_det_non_ref + rho_mrcc(i,s) = 0.d0 + enddo do a_coll=1,n_exc_active a_col = active_pp_idx(a_coll) do j=1,N_det_non_ref i = active_excitation_to_determinants_idx(j,a_coll) if (i==0) exit + if (rho_mrcc_inact(i) /= 0.d0) then + call debug_det(psi_non_ref(1,1,i),N_int) + stop + endif rho_mrcc(i,s) = rho_mrcc(i,s) + active_excitation_to_determinants_val(s,j,a_coll) * dIj_unique(a_col,s) enddo end do - norm = 0.d0 - do i=1,N_det_non_ref - norm = norm + rho_mrcc(i,s)*rho_mrcc(i,s) - enddo - ! Norm now contains the norm of A.X - + double precision :: norm2_ref, norm2_inact, a, b, c, Delta + ! Psi = Psi_ref + Psi_inactive + f*Psi_active + ! Find f to normalize Psi + + norm2_ref = 0.d0 do i=1,N_det_ref - norm = norm + psi_ref_coef(i,s)*psi_ref_coef(i,s) + norm2_ref = norm2_ref + psi_ref_coef(i,s)*psi_ref_coef(i,s) enddo - ! Norm now contains the norm of Psi + A.X - + + a = 0.d0 + do i=1,N_det_non_ref + a = a + rho_mrcc(i,s)*rho_mrcc(i,s) + enddo + + norm = a + norm2_ref print *, "norm : ", sqrt(norm) - enddo + + norm = sqrt((1.d0-norm2_ref)/a) + + ! Renormalize Psi+A.X + do i=1,N_det_non_ref + rho_mrcc(i,s) = rho_mrcc(i,s) * norm + enddo + +!norm = norm2_ref +!do i=1,N_det_non_ref +! norm = norm + rho_mrcc(i,s)**2 +!enddo +!print *, 'check', norm +!stop + - do s=1,N_states norm = 0.d0 double precision :: f, g, gmax - gmax = 1.d0*maxval(dabs(psi_non_ref_coef(:,s))) + gmax = maxval(dabs(psi_non_ref_coef(:,s))) do i=1,N_det_non_ref if (lambda_type == 2) then f = 1.d0 @@ -891,41 +913,22 @@ END_PROVIDER f = psi_non_ref_coef(i,s) / rho_mrcc(i,s) ! Avoid numerical instabilities -! g = 1.d0+dabs(gmax / psi_non_ref_coef(i,s) ) g = 2.d0+100.d0*exp(-20.d0*dabs(psi_non_ref_coef(i,s)/gmax)) f = min(f, g) f = max(f,-g) + endif - norm = norm + f*f *rho_mrcc(i,s)*rho_mrcc(i,s) + norm = norm + (rho_mrcc(i,s)*f)**2 rho_mrcc(i,s) = f enddo - ! norm now contains the norm of |T.Psi_0> - ! rho_mrcc now contains the f factors - - f = 1.d0/norm - ! f now contains 1/ - - norm = 0.d0 - do i=1,N_det_non_ref - norm = norm + psi_non_ref_coef(i,s)*psi_non_ref_coef(i,s) - enddo - ! norm now contains - f = dsqrt(f*norm) - ! f normalises T.Psi_0 such that (1+T)|Psi> is normalized + ! rho_mrcc now contains the mu_i factors print *, 'norm of |T Psi_0> = ', dsqrt(norm) - norm = norm*f - if (dsqrt(norm) > 1.d0) then + if (norm > 1.d0) then stop 'Error : Norm of the SD larger than the norm of the reference.' endif - do i=1,N_det_non_ref - rho_mrcc(i,s) = rho_mrcc(i,s) * f - enddo - ! rho_mrcc now contains the product of the scaling factors and the - ! normalization constant - end do END_PROVIDER @@ -1028,11 +1031,11 @@ double precision function get_dij(det1, det2, s, Nint) integer, intent(in) :: s, Nint integer(bit_kind) :: det1(Nint, 2), det2(Nint, 2) integer :: degree, f, exc(0:2, 2, 2), t - integer*2 :: h1, h2, p1, p2, s1, s2 + integer :: h1, h2, p1, p2, s1, s2 integer, external :: searchExc logical, external :: excEq double precision :: phase - integer*2 :: tmp_array(4) + integer :: tmp_array(4) get_dij = 0d0 call get_excitation(det1, det2, exc, degree, phase, Nint) @@ -1041,7 +1044,7 @@ double precision function get_dij(det1, det2, s, Nint) stop "get_dij" end if - call decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) if(degree == 1) then h2 = h1 @@ -1074,8 +1077,8 @@ double precision function get_dij(det1, det2, s, Nint) end function - BEGIN_PROVIDER [ integer*2, hh_exists, (4, N_hh_exists) ] -&BEGIN_PROVIDER [ integer*2, pp_exists, (4, N_pp_exists) ] + BEGIN_PROVIDER [ integer, hh_exists, (4, N_hh_exists) ] +&BEGIN_PROVIDER [ integer, pp_exists, (4, N_pp_exists) ] &BEGIN_PROVIDER [ integer, hh_shortcut, (0:N_hh_exists + 1) ] &BEGIN_PROVIDER [ integer, hh_nex ] implicit none @@ -1090,9 +1093,9 @@ end function ! hh_nex : Total number of excitation operators ! END_DOC - integer*2,allocatable :: num(:,:) + integer,allocatable :: num(:,:) integer :: exc(0:2, 2, 2), degree, n, on, s, l, i - integer*2 :: h1, h2, p1, p2 + integer :: h1, h2, p1, p2 double precision :: phase logical, external :: excEq @@ -1118,19 +1121,19 @@ end function hh_shortcut(0) = 1 hh_shortcut(1) = 1 - hh_exists(:,1) = (/1_2, num(1,1), 1_2, num(2,1)/) - pp_exists(:,1) = (/1_2, num(3,1), 1_2, num(4,1)/) + hh_exists(:,1) = (/1, num(1,1), 1, num(2,1)/) + pp_exists(:,1) = (/1, num(3,1), 1, num(4,1)/) s = 1 do i=2,n if(.not. excEq(num(1,i), num(1,s))) then s += 1 num(:, s) = num(:, i) - pp_exists(:,s) = (/1_2, num(3,s), 1_2, num(4,s)/) + pp_exists(:,s) = (/1, num(3,s), 1, num(4,s)/) if(hh_exists(2, hh_shortcut(0)) /= num(1,s) .or. & hh_exists(4, hh_shortcut(0)) /= num(2,s)) then hh_shortcut(0) += 1 hh_shortcut(hh_shortcut(0)) = s - hh_exists(:,hh_shortcut(0)) = (/1_2, num(1,s), 1_2, num(2,s)/) + hh_exists(:,hh_shortcut(0)) = (/1, num(1,s), 1, num(2,s)/) end if end if end do @@ -1178,7 +1181,7 @@ END_PROVIDER logical function excEq(exc1, exc2) implicit none - integer*2, intent(in) :: exc1(4), exc2(4) + integer, intent(in) :: exc1(4), exc2(4) integer :: i excEq = .false. do i=1, 4 @@ -1190,7 +1193,7 @@ end function integer function excCmp(exc1, exc2) implicit none - integer*2, intent(in) :: exc1(4), exc2(4) + integer, intent(in) :: exc1(4), exc2(4) integer :: i excCmp = 0 do i=1, 4 @@ -1209,8 +1212,8 @@ subroutine apply_hole_local(det, exc, res, ok, Nint) use bitmasks implicit none integer, intent(in) :: Nint - integer*2, intent(in) :: exc(4) - integer*2 :: s1, s2, h1, h2 + integer, intent(in) :: exc(4) + integer :: s1, s2, h1, h2 integer(bit_kind),intent(in) :: det(Nint, 2) integer(bit_kind),intent(out) :: res(Nint, 2) logical, intent(out) :: ok @@ -1246,8 +1249,8 @@ subroutine apply_particle_local(det, exc, res, ok, Nint) use bitmasks implicit none integer, intent(in) :: Nint - integer*2, intent(in) :: exc(4) - integer*2 :: s1, s2, p1, p2 + integer, intent(in) :: exc(4) + integer :: s1, s2, p1, p2 integer(bit_kind),intent(in) :: det(Nint, 2) integer(bit_kind),intent(out) :: res(Nint, 2) logical, intent(out) :: ok diff --git a/plugins/MRPT/MRPT_Utils.main.irp.f b/plugins/MRPT/MRPT_Utils.main.irp.f index 24361312..1b6efb4f 100644 --- a/plugins/MRPT/MRPT_Utils.main.irp.f +++ b/plugins/MRPT/MRPT_Utils.main.irp.f @@ -46,19 +46,6 @@ end subroutine routine_2 implicit none - integer :: i - do i = 1, n_core_inact_orb - print*,fock_core_inactive_total(i,1,1),fock_core_inactive(i) - enddo - double precision :: accu - accu = 0.d0 - do i = 1, n_act_orb - integer :: j_act_orb - j_act_orb = list_act(i) - accu += one_body_dm_mo_alpha(j_act_orb,j_act_orb,1) - print*,one_body_dm_mo_alpha(j_act_orb,j_act_orb,1),one_body_dm_mo_beta(j_act_orb,j_act_orb,1) - enddo - print*,'accu = ',accu - + provide electronic_psi_ref_average_value end diff --git a/plugins/MRPT_Utils/MRMP2_density.irp.f b/plugins/MRPT_Utils/MRMP2_density.irp.f new file mode 100644 index 00000000..1051edf9 --- /dev/null +++ b/plugins/MRPT_Utils/MRMP2_density.irp.f @@ -0,0 +1,46 @@ +BEGIN_PROVIDER [double precision, MRMP2_density, (mo_tot_num_align, mo_tot_num)] + implicit none + integer :: i,j,k,l + double precision :: accu, mp2_dm(mo_tot_num) + MRMP2_density = one_body_dm_mo + call give_2h2p_density(mp2_dm) + accu = 0.d0 + do i = 1, n_virt_orb + j = list_virt(i) + accu += mp2_dm(j) + MRMP2_density(j,j)+= mp2_dm(j) + enddo + +END_PROVIDER + +subroutine give_2h2p_density(mp2_density_diag_alpha_beta) + implicit none + double precision, intent(out) :: mp2_density_diag_alpha_beta(mo_tot_num) + integer :: i,j,k,l,m + integer :: iorb,jorb,korb,lorb + + double precision :: get_mo_bielec_integral + double precision :: direct_int + double precision :: coef_double + + mp2_density_diag_alpha_beta = 0.d0 + do k = 1, n_virt_orb + korb = list_virt(k) + do i = 1, n_inact_orb + iorb = list_inact(i) + do j = 1, n_inact_orb + jorb = list_inact(j) + do l = 1, n_virt_orb + lorb = list_virt(l) + direct_int = get_mo_bielec_integral(iorb,jorb,korb,lorb ,mo_integrals_map) + coef_double = direct_int/(fock_core_inactive_total_spin_trace(iorb,1) + fock_core_inactive_total_spin_trace(jorb,1) & + -fock_virt_total_spin_trace(korb,1) - fock_virt_total_spin_trace(lorb,1)) + mp2_density_diag_alpha_beta(korb) += coef_double * coef_double + enddo + enddo + enddo + print*, mp2_density_diag_alpha_beta(korb) + enddo + +end + diff --git a/plugins/MRPT_Utils/energies_cas.irp.f b/plugins/MRPT_Utils/energies_cas.irp.f index 02077ebc..e8d19166 100644 --- a/plugins/MRPT_Utils/energies_cas.irp.f +++ b/plugins/MRPT_Utils/energies_cas.irp.f @@ -293,7 +293,8 @@ BEGIN_PROVIDER [ double precision, one_anhil_one_creat, (n_act_orb,n_act_orb,2,2 END_PROVIDER -BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_act_orb,2,2,2,N_states)] + BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_act_orb,2,2,2,N_states)] +&BEGIN_PROVIDER [ double precision, two_anhil_one_creat_norm, (n_act_orb,n_act_orb,n_act_orb,2,2,2,N_states)] implicit none integer :: i,j integer :: ispin,jspin,kspin @@ -344,6 +345,7 @@ BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_a norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states) call u0_H_dyall_u0_no_exchange(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target) two_anhil_one_creat(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall_no_exchange(state_target) - energies(state_target) + two_anhil_one_creat_norm(iorb,jorb,korb,ispin,jspin,kspin,state_target) = norm_out(state_target) enddo enddo enddo @@ -355,7 +357,54 @@ BEGIN_PROVIDER [ double precision, two_anhil_one_creat, (n_act_orb,n_act_orb,n_a END_PROVIDER -BEGIN_PROVIDER [ double precision, two_creat_one_anhil, (n_act_orb,n_act_orb,n_act_orb,2,2,2,N_states)] + + BEGIN_PROVIDER [ double precision, two_anhil_one_creat_spin_average, (n_act_orb,n_act_orb,n_act_orb,N_states)] + implicit none + integer :: i,j + integer :: ispin,jspin,kspin + integer :: orb_i, hole_particle_i,spin_exc_i + integer :: orb_j, hole_particle_j,spin_exc_j + integer :: orb_k, hole_particle_k,spin_exc_k + double precision :: norm_out(N_states) + integer(bit_kind), allocatable :: psi_in_out(:,:,:) + double precision, allocatable :: psi_in_out_coef(:,:) + use bitmasks + allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det_ref,N_states)) + + integer :: iorb,jorb + integer :: korb + integer :: state_target + double precision :: energies(n_states) + double precision :: accu + do iorb = 1,n_act_orb + orb_i = list_act(iorb) + do jorb = 1, n_act_orb + orb_j = list_act(jorb) + do korb = 1, n_act_orb + orb_k = list_act(korb) + do state_target = 1, N_states + accu = 0.d0 + do ispin = 1,2 + do jspin = 1,2 + do kspin = 1,2 + two_anhil_one_creat_spin_average(iorb,jorb,korb,state_target) += two_anhil_one_creat(iorb,jorb,korb,ispin,jspin,kspin,state_target)* & + two_anhil_one_creat_norm(iorb,jorb,korb,ispin,jspin,kspin,state_target) + accu += two_anhil_one_creat_norm(iorb,jorb,korb,ispin,jspin,kspin,state_target) + enddo + enddo + enddo + two_anhil_one_creat_spin_average(iorb,jorb,korb,state_target) = two_anhil_one_creat_spin_average(iorb,jorb,korb,state_target) /accu + enddo + enddo + enddo + enddo + deallocate(psi_in_out,psi_in_out_coef) + +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, two_creat_one_anhil, (n_act_orb,n_act_orb,n_act_orb,2,2,2,N_states)] +&BEGIN_PROVIDER [ double precision, two_creat_one_anhil_norm, (n_act_orb,n_act_orb,n_act_orb,2,2,2,N_states)] implicit none integer :: i,j integer :: ispin,jspin,kspin @@ -406,6 +455,8 @@ implicit none norm_out,psi_in_out,psi_in_out_coef, n_det_ref,n_det_ref,n_det_ref,N_states) call u0_H_dyall_u0_no_exchange(energies,psi_in_out,psi_in_out_coef,n_det_ref,n_det_ref,n_det_ref,N_states,state_target) two_creat_one_anhil(iorb,jorb,korb,ispin,jspin,kspin,state_target) = energy_cas_dyall_no_exchange(state_target) - energies(state_target) + two_creat_one_anhil_norm(iorb,jorb,korb,ispin,jspin,kspin,state_target) = norm_out(state_target) +! print*, norm_out(state_target) enddo enddo enddo @@ -415,6 +466,51 @@ implicit none enddo deallocate(psi_in_out,psi_in_out_coef) +END_PROVIDER + + + BEGIN_PROVIDER [ double precision, two_creat_one_anhil_spin_average, (n_act_orb,n_act_orb,n_act_orb,N_states)] +implicit none + integer :: i,j + integer :: ispin,jspin,kspin + integer :: orb_i, hole_particle_i,spin_exc_i + integer :: orb_j, hole_particle_j,spin_exc_j + integer :: orb_k, hole_particle_k,spin_exc_k + double precision :: norm_out(N_states) + integer(bit_kind), allocatable :: psi_in_out(:,:,:) + double precision, allocatable :: psi_in_out_coef(:,:) + use bitmasks + allocate (psi_in_out(N_int,2,n_det),psi_in_out_coef(n_det_ref,N_states)) + + integer :: iorb,jorb + integer :: korb + integer :: state_target + double precision :: energies(n_states),accu + do iorb = 1,n_act_orb + orb_i = list_act(iorb) + do jorb = 1, n_act_orb + orb_j = list_act(jorb) + do korb = 1, n_act_orb + orb_k = list_act(korb) + do state_target = 1, N_states + accu = 0.d0 + do ispin = 1,2 + do jspin = 1,2 + do kspin = 1,2 + two_creat_one_anhil_spin_average(iorb,jorb,korb,state_target) += two_creat_one_anhil(iorb,jorb,korb,ispin,jspin,kspin,state_target) * & + two_creat_one_anhil_norm(iorb,jorb,korb,ispin,jspin,kspin,state_target) + accu += two_creat_one_anhil_norm(iorb,jorb,korb,ispin,jspin,kspin,state_target) + print*, accu + enddo + enddo + enddo + two_creat_one_anhil_spin_average(iorb,jorb,korb,state_target) = two_creat_one_anhil_spin_average(iorb,jorb,korb,state_target) / accu + enddo + enddo + enddo + enddo + deallocate(psi_in_out,psi_in_out_coef) + END_PROVIDER !BEGIN_PROVIDER [ double precision, two_creat_one_anhil, (n_act_orb,n_act_orb,n_act_orb,N_states)] @@ -1071,11 +1167,11 @@ subroutine give_singles_and_partial_doubles_1h1p_contrib(matrix_1h1p,e_corr_from print*, 'e corr perturb EN',accu(state_target) print*, '' print*, 'coef diagonalized' - write(*,'(100(F16.10,X))')psi_in_out_coef(:,state_target) + write(*,'(100(F16.10,1X))')psi_in_out_coef(:,state_target) print*, 'coef_perturb' - write(*,'(100(F16.10,X))')coef_perturb(:) + write(*,'(100(F16.10,1X))')coef_perturb(:) print*, 'coef_perturb EN' - write(*,'(100(F16.10,X))')coef_perturb_bis(:) + write(*,'(100(F16.10,1X))')coef_perturb_bis(:) endif integer :: k do k = 1, N_det_ref diff --git a/plugins/MRPT_Utils/excitations_cas.irp.f b/plugins/MRPT_Utils/excitations_cas.irp.f index 4042d90b..9376e0cc 100644 --- a/plugins/MRPT_Utils/excitations_cas.irp.f +++ b/plugins/MRPT_Utils/excitations_cas.irp.f @@ -22,7 +22,7 @@ subroutine apply_exc_to_psi(orb,hole_particle,spin_exc, & integer :: elec_num_tab_local(2) integer :: i,j,accu_elec,k - integer :: det_tmp(N_int), det_tmp_bis(N_int) + integer(bit_kind) :: det_tmp(N_int), det_tmp_bis(N_int) double precision :: phase double precision :: norm_factor ! print*, orb,hole_particle,spin_exc diff --git a/plugins/MRPT_Utils/ezfio_interface.irp.f b/plugins/MRPT_Utils/ezfio_interface.irp.f deleted file mode 100644 index e8cabd2d..00000000 --- a/plugins/MRPT_Utils/ezfio_interface.irp.f +++ /dev/null @@ -1,42 +0,0 @@ -! DO NOT MODIFY BY HAND -! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py -! from file /home/giner/qp_bis/quantum_package/src/MRPT_Utils/EZFIO.cfg - - -BEGIN_PROVIDER [ logical, do_third_order_1h1p ] - implicit none - BEGIN_DOC -! If true, compute the third order contribution for the 1h1p - END_DOC - - logical :: has - PROVIDE ezfio_filename - - call ezfio_has_mrpt_utils_do_third_order_1h1p(has) - if (has) then - call ezfio_get_mrpt_utils_do_third_order_1h1p(do_third_order_1h1p) - else - print *, 'mrpt_utils/do_third_order_1h1p not found in EZFIO file' - stop 1 - endif - -END_PROVIDER - -BEGIN_PROVIDER [ logical, save_heff_eigenvectors ] - implicit none - BEGIN_DOC -! If true, save the eigenvectors of the dressed matrix at the end of the MRPT calculation - END_DOC - - logical :: has - PROVIDE ezfio_filename - - call ezfio_has_mrpt_utils_save_heff_eigenvectors(has) - if (has) then - call ezfio_get_mrpt_utils_save_heff_eigenvectors(save_heff_eigenvectors) - else - print *, 'mrpt_utils/save_heff_eigenvectors not found in EZFIO file' - stop 1 - endif - -END_PROVIDER diff --git a/plugins/MRPT_Utils/mrpt_dress.irp.f b/plugins/MRPT_Utils/mrpt_dress.irp.f index 9699a1df..a08b6108 100644 --- a/plugins/MRPT_Utils/mrpt_dress.irp.f +++ b/plugins/MRPT_Utils/mrpt_dress.irp.f @@ -121,14 +121,19 @@ subroutine mrpt_dress(delta_ij_, Ndet,i_generator,n_selected,det_buffer,Nint,ip delta_e(i_state) = 1.d+20 enddo else - call get_delta_e_dyall(psi_ref(1,1,index_i),tq(1,1,i_alpha),coef_array,hialpha,delta_e) + call get_delta_e_dyall(psi_ref(1,1,index_i),tq(1,1,i_alpha),delta_e) + if(degree_scalar.eq.1)then + delta_e = 1.d+20 + endif +! print*, 'delta_e',delta_e !!!!!!!!!!!!! SHIFTED BK ! double precision :: hjj ! call i_h_j(tq(1,1,i_alpha),tq(1,1,i_alpha),Nint,hjj) -! delta_e(1) = CI_electronic_energy(1) - hjj +! delta_e(1) = electronic_psi_ref_average_value(1) - hjj ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! endif hij_array(index_i) = hialpha +! print*, 'hialpha ',hialpha do i_state = 1,N_states delta_e_inv_array(index_i,i_state) = 1.d0/delta_e(i_state) enddo diff --git a/plugins/MRPT_Utils/mrpt_utils.irp.f b/plugins/MRPT_Utils/mrpt_utils.irp.f index d7b1f0f6..79aa624f 100644 --- a/plugins/MRPT_Utils/mrpt_utils.irp.f +++ b/plugins/MRPT_Utils/mrpt_utils.irp.f @@ -34,43 +34,44 @@ accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) enddo + write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) enddo second_order_pt_new_1h(i_state) = accu(i_state) enddo print*, '1h = ',accu - ! 1p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1p(delta_ij_tmp,N_det) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det - do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_1p(i_state) = accu(i_state) - enddo - print*, '1p = ',accu +!! 1p +!delta_ij_tmp = 0.d0 +!call H_apply_mrpt_1p(delta_ij_tmp,N_det) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) +!enddo +!second_order_pt_new_1p(i_state) = accu(i_state) +!enddo +!print*, '1p = ',accu ! 1h1p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_1h1p(delta_ij_tmp,N_det) - double precision :: e_corr_from_1h1p_singles(N_states) -!call give_singles_and_partial_doubles_1h1p_contrib(delta_ij_tmp,e_corr_from_1h1p_singles) -!call give_1h1p_only_doubles_spin_cross(delta_ij_tmp) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det - do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_1h1p(i_state) = accu(i_state) - enddo - print*, '1h1p = ',accu +!delta_ij_tmp = 0.d0 +!call H_apply_mrpt_1h1p(delta_ij_tmp,N_det) +!double precision :: e_corr_from_1h1p_singles(N_states) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) +!enddo +!second_order_pt_new_1h1p(i_state) = accu(i_state) +!enddo +!print*, '1h1p = ',accu ! 1h1p third order if(do_third_order_1h1p)then @@ -83,75 +84,80 @@ accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) enddo + write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) enddo second_order_pt_new_1h1p(i_state) = accu(i_state) enddo print*, '1h1p(3)',accu endif - ! 2h - delta_ij_tmp = 0.d0 - call H_apply_mrpt_2h(delta_ij_tmp,N_det) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det - do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_2h(i_state) = accu(i_state) - enddo - print*, '2h = ',accu +!! 2h +!delta_ij_tmp = 0.d0 +!call H_apply_mrpt_2h(delta_ij_tmp,N_det) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) +!enddo +!second_order_pt_new_2h(i_state) = accu(i_state) +!enddo +!print*, '2h = ',accu - ! 2p - delta_ij_tmp = 0.d0 - call H_apply_mrpt_2p(delta_ij_tmp,N_det) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det - do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_2p(i_state) = accu(i_state) - enddo - print*, '2p = ',accu +!! 2p +!delta_ij_tmp = 0.d0 +!call H_apply_mrpt_2p(delta_ij_tmp,N_det) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) +!enddo +!second_order_pt_new_2p(i_state) = accu(i_state) +!enddo +!print*, '2p = ',accu ! 1h2p delta_ij_tmp = 0.d0 !call give_1h2p_contrib(delta_ij_tmp) - call H_apply_mrpt_1h2p(delta_ij_tmp,N_det) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det - do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_1h2p(i_state) = accu(i_state) - enddo - print*, '1h2p = ',accu +!call H_apply_mrpt_1h2p(delta_ij_tmp,N_det) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) +!enddo +!second_order_pt_new_1h2p(i_state) = accu(i_state) +!enddo +!print*, '1h2p = ',accu - ! 2h1p - delta_ij_tmp = 0.d0 +!! 2h1p +!delta_ij_tmp = 0.d0 !call give_2h1p_contrib(delta_ij_tmp) - call H_apply_mrpt_2h1p(delta_ij_tmp,N_det) - accu = 0.d0 - do i_state = 1, N_states - do i = 1, N_det - do j = 1, N_det - accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) - delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) - enddo - enddo - second_order_pt_new_2h1p(i_state) = accu(i_state) - enddo - print*, '2h1p = ',accu +!call H_apply_mrpt_2h1p(delta_ij_tmp,N_det) +!accu = 0.d0 +!do i_state = 1, N_states +!do i = 1, N_det +! do j = 1, N_det +! accu(i_state) += delta_ij_tmp(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) +! delta_ij(j,i,i_state) += delta_ij_tmp(j,i,i_state) +! enddo +! write(*,'(1000(F16.10,x))')delta_ij_tmp(i,:,:) +!enddo +!second_order_pt_new_2h1p(i_state) = accu(i_state) +!enddo +!print*, '2h1p = ',accu - ! 2h2p +!! 2h2p !delta_ij_tmp = 0.d0 !call H_apply_mrpt_2h2p(delta_ij_tmp,N_det) !accu = 0.d0 @@ -178,10 +184,13 @@ ! total + print*, '' + print*, 'total dressing' + print*, '' accu = 0.d0 do i_state = 1, N_states do i = 1, N_det -! write(*,'(1000(F16.10,x))')delta_ij(i,:,:) + write(*,'(1000(F16.10,x))')delta_ij(i,:,:) do j = i_state, N_det accu(i_state) += delta_ij(j,i,i_state) * psi_coef(i,i_state) * psi_coef(j,i_state) enddo @@ -223,7 +232,7 @@ END_PROVIDER enddo END_PROVIDER - BEGIN_PROVIDER [ double precision, CI_electronic_dressed_pt2_new_energy, (N_states_diag) ] + BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_electronic_energy, (N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors, (N_det,N_states_diag) ] &BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_eigenvectors_s2, (N_states_diag) ] BEGIN_DOC @@ -245,7 +254,7 @@ END_PROVIDER integer, allocatable :: iorder(:) ! Guess values for the "N_states_diag" states of the CI_dressed_pt2_new_eigenvectors - do j=1,min(N_states_diag,N_det) + do j=1,min(N_states,N_det) do i=1,N_det CI_dressed_pt2_new_eigenvectors(i,j) = psi_coef(i,j) enddo @@ -267,7 +276,7 @@ END_PROVIDER allocate (eigenvectors(size(H_matrix_all_dets,1),N_det)) allocate (eigenvalues(N_det)) call lapack_diag(eigenvalues,eigenvectors, & - H_matrix_all_dets,size(H_matrix_all_dets,1),N_det) + Hmatrix_dressed_pt2_new_symmetrized,size(H_matrix_all_dets,1),N_det) CI_electronic_energy(:) = 0.d0 if (s2_eig) then i_state = 0 @@ -276,8 +285,10 @@ END_PROVIDER good_state_array = .False. call u_0_S2_u_0(s2_eigvalues,eigenvectors,N_det,psi_det,N_int,& N_det,size(eigenvectors,1)) + print*,'N_det',N_det do j=1,N_det ! Select at least n_states states with S^2 values closed to "expected_s2" + print*, s2_eigvalues(j),expected_s2 if(dabs(s2_eigvalues(j)-expected_s2).le.0.5d0)then i_state +=1 index_good_state_array(i_state) = j @@ -291,10 +302,10 @@ END_PROVIDER ! Fill the first "i_state" states that have a correct S^2 value do j = 1, i_state do i=1,N_det - CI_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j)) + CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,index_good_state_array(j)) enddo - CI_electronic_energy(j) = eigenvalues(index_good_state_array(j)) - CI_eigenvectors_s2(j) = s2_eigvalues(index_good_state_array(j)) + CI_dressed_pt2_new_electronic_energy(j) = eigenvalues(index_good_state_array(j)) + CI_dressed_pt2_new_eigenvectors_s2(j) = s2_eigvalues(index_good_state_array(j)) enddo i_other_state = 0 do j = 1, N_det @@ -304,10 +315,10 @@ END_PROVIDER exit endif do i=1,N_det - CI_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j) + CI_dressed_pt2_new_eigenvectors(i,i_state+i_other_state) = eigenvectors(i,j) enddo - CI_electronic_energy(i_state+i_other_state) = eigenvalues(j) - CI_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) + CI_dressed_pt2_new_electronic_energy(i_state+i_other_state) = eigenvalues(j) + CI_dressed_pt2_new_eigenvectors_s2(i_state+i_other_state) = s2_eigvalues(i_state+i_other_state) enddo else @@ -322,10 +333,10 @@ END_PROVIDER print*,'' do j=1,min(N_states_diag,N_det) do i=1,N_det - CI_eigenvectors(i,j) = eigenvectors(i,j) + CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,j) enddo - CI_electronic_energy(j) = eigenvalues(j) - CI_eigenvectors_s2(j) = s2_eigvalues(j) + CI_dressed_pt2_new_electronic_energy(j) = eigenvalues(j) + CI_dressed_pt2_new_eigenvectors_s2(j) = s2_eigvalues(j) enddo endif deallocate(index_good_state_array,good_state_array) @@ -336,9 +347,9 @@ END_PROVIDER ! Select the "N_states_diag" states of lowest energy do j=1,min(N_det,N_states_diag) do i=1,N_det - CI_eigenvectors(i,j) = eigenvectors(i,j) + CI_dressed_pt2_new_eigenvectors(i,j) = eigenvectors(i,j) enddo - CI_electronic_energy(j) = eigenvalues(j) + CI_dressed_pt2_new_electronic_energy(j) = eigenvalues(j) enddo endif deallocate(eigenvectors,eigenvalues) @@ -358,7 +369,7 @@ BEGIN_PROVIDER [ double precision, CI_dressed_pt2_new_energy, (N_states_diag) ] character*(8) :: st call write_time(output_determinants) do j=1,N_states_diag - CI_dressed_pt2_new_energy(j) = CI_electronic_dressed_pt2_new_energy(j) + nuclear_repulsion + CI_dressed_pt2_new_energy(j) = CI_dressed_pt2_new_electronic_energy(j) + nuclear_repulsion write(st,'(I4)') j call write_double(output_determinants,CI_dressed_pt2_new_energy(j),'Energy of state '//trim(st)) call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st)) diff --git a/plugins/MRPT_Utils/new_way_second_order_coef.irp.f b/plugins/MRPT_Utils/new_way_second_order_coef.irp.f index 676e14e9..b67f7498 100644 --- a/plugins/MRPT_Utils/new_way_second_order_coef.irp.f +++ b/plugins/MRPT_Utils/new_way_second_order_coef.irp.f @@ -210,10 +210,6 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p) ! < det_tmp | H | det_tmp_bis > = F_{aorb,borb} hab = (fock_operator_local(aorb,borb,kspin) ) * phase - if(isnan(hab))then - print*, '1' - stop - endif ! < jdet | H | det_tmp_bis > = phase * (ir|cv) call get_double_excitation(det_tmp_bis,psi_det(1,1,idx(jdet)),exc,phase,N_int) if(ispin == jspin)then @@ -255,7 +251,8 @@ subroutine give_2h1p_contrib_sec_order(matrix_2h1p) call get_mono_excitation(det_tmp,det_tmp_bis,exc,phase,N_int) ! ! < det_tmp | H | det_tmp_bis > = F_{aorb,borb} hab = fock_operator_local(aorb,borb,kspin) * phase - if(isnan(hab))then +! if(isnan(hab))then + if(hab /= hab)then print*, '2' stop endif diff --git a/plugins/MRPT_Utils/psi_active_prov.irp.f b/plugins/MRPT_Utils/psi_active_prov.irp.f index d9c5fda3..f86947d8 100644 --- a/plugins/MRPT_Utils/psi_active_prov.irp.f +++ b/plugins/MRPT_Utils/psi_active_prov.irp.f @@ -354,7 +354,8 @@ subroutine get_delta_e_dyall(det_1,det_2,delta_e_final) kspin = particle_list_practical(1,1) i_particle_act = particle_list_practical(2,1) do i_state = 1, N_states - delta_e_act(i_state) += two_anhil_one_creat(i_particle_act,i_hole_act,j_hole_act,kspin,ispin,jspin,i_state) +! delta_e_act(i_state) += two_anhil_one_creat(i_particle_act,i_hole_act,j_hole_act,kspin,ispin,jspin,i_state) + delta_e_act(i_state) += two_anhil_one_creat_spin_average(i_particle_act,i_hole_act,j_hole_act,i_state) enddo else if (n_holes_act == 1 .and. n_particles_act == 2) then @@ -369,7 +370,9 @@ subroutine get_delta_e_dyall(det_1,det_2,delta_e_final) j_particle_act = particle_list_practical(2,2) do i_state = 1, N_states - delta_e_act(i_state) += two_creat_one_anhil(i_particle_act,j_particle_act,i_hole_act,jspin,kspin,ispin,i_state) +! delta_e_act(i_state) += two_creat_one_anhil(i_particle_act,j_particle_act,i_hole_act,jspin,kspin,ispin,i_state) + delta_e_act(i_state) += 0.5d0 * (two_creat_one_anhil_spin_average(i_particle_act,j_particle_act,i_hole_act,i_state) & + +two_creat_one_anhil_spin_average(j_particle_act,i_particle_act,i_hole_act,i_state)) enddo else if (n_holes_act == 3 .and. n_particles_act == 0) then diff --git a/plugins/Properties/delta_rho.irp.f b/plugins/Properties/delta_rho.irp.f index 7803ba3d..8fd08246 100644 --- a/plugins/Properties/delta_rho.irp.f +++ b/plugins/Properties/delta_rho.irp.f @@ -6,7 +6,7 @@ z_min = 0.d0 z_max = 10.d0 delta_z = 0.005d0 - N_z_pts = (z_max - z_min)/delta_z + N_z_pts = int( (z_max - z_min)/delta_z ) print*,'N_z_pts = ',N_z_pts END_PROVIDER diff --git a/plugins/Properties/hyperfine_constants.irp.f b/plugins/Properties/hyperfine_constants.irp.f index 6fa39278..91b26dc8 100644 --- a/plugins/Properties/hyperfine_constants.irp.f +++ b/plugins/Properties/hyperfine_constants.irp.f @@ -151,7 +151,7 @@ subroutine print_hcc integer :: i,j print*,'Z AU GAUSS MHZ cm^-1' do i = 1, nucl_num - write(*,'(I2,X,F4.1,X,4(F16.6,X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i) + write(*,'(I2,1X,F4.1,1X,4(F16.6,1X))')i,nucl_charge(i),spin_density_at_nucleous(i),iso_hcc_gauss(i),iso_hcc_mhz(i),iso_hcc_cm_1(i) enddo end diff --git a/plugins/Properties/mulliken.irp.f b/plugins/Properties/mulliken.irp.f index deeb90bf..68b620c5 100644 --- a/plugins/Properties/mulliken.irp.f +++ b/plugins/Properties/mulliken.irp.f @@ -126,7 +126,7 @@ subroutine print_mulliken_sd accu = 0.d0 do i = 1, ao_num accu += spin_gross_orbital_product(i) - write(*,'(X,I3,X,A4,X,I2,X,A4,X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i) + write(*,'(1X,I3,1X,A4,1X,I2,1X,A4,1X,F10.7)')i,trim(element_name(int(nucl_charge(ao_nucl(i))))),ao_nucl(i),trim(l_to_charater(ao_l(i))),spin_gross_orbital_product(i) enddo print*,'sum = ',accu accu = 0.d0 @@ -142,7 +142,7 @@ subroutine print_mulliken_sd accu = 0.d0 do i = 0, ao_l_max accu += spin_population_angular_momentum_per_atom(i,j) - write(*,'(XX,I3,XX,A4,X,A4,X,F10.7)')j,trim(element_name(int(nucl_charge(j)))),trim(l_to_charater(i)),spin_population_angular_momentum_per_atom(i,j) + write(*,'(1X,I3,1X,A4,1X,A4,1X,F10.7)')j,trim(element_name(int(nucl_charge(j)))),trim(l_to_charater(i)),spin_population_angular_momentum_per_atom(i,j) print*,'sum = ',accu enddo enddo diff --git a/plugins/Psiref_CAS/psi_ref.irp.f b/plugins/Psiref_CAS/psi_ref.irp.f index b0a4a353..8380d668 100644 --- a/plugins/Psiref_CAS/psi_ref.irp.f +++ b/plugins/Psiref_CAS/psi_ref.irp.f @@ -72,10 +72,20 @@ END_PROVIDER &BEGIN_PROVIDER [double precision, psi_ref_average_value, (N_states)] implicit none integer :: i,j - call u_0_H_u_0(electronic_psi_ref_average_value,psi_ref_coef,N_det_ref,psi_ref,N_int,N_states,psi_det_size) + electronic_psi_ref_average_value = psi_energy do i = 1, N_states - psi_ref_average_value(i) = electronic_psi_ref_average_value(i) + nuclear_repulsion + psi_ref_average_value(i) = psi_energy(i) + nuclear_repulsion enddo + double precision :: accu,hij + accu = 0.d0 + do i = 1, N_det_ref + do j = 1, N_det_ref + call i_H_j(psi_ref(1,1,i),psi_ref(1,1,j),N_int,hij) + accu += psi_ref_coef(i,1) * psi_ref_coef(j,1) * hij + enddo + enddo + electronic_psi_ref_average_value(1) = accu + psi_ref_average_value(1) = electronic_psi_ref_average_value(1) + nuclear_repulsion END_PROVIDER BEGIN_PROVIDER [double precision, norm_psi_ref, (N_states)] diff --git a/plugins/analyze_wf/analyze_wf.irp.f b/plugins/analyze_wf/analyze_wf.irp.f index 6d8bffcf..7d005a05 100644 --- a/plugins/analyze_wf/analyze_wf.irp.f +++ b/plugins/analyze_wf/analyze_wf.irp.f @@ -18,7 +18,7 @@ subroutine run write(*,'(A)') '=============' write(*,'(A)') '' do istate=1,N_states - call get_occupation_from_dets(occupation,1) + call get_occupation_from_dets(occupation,istate) write(*,'(A)') '' write(*,'(A,I3)'), 'State ', istate write(*,'(A)') '---------------' @@ -30,13 +30,13 @@ subroutine run if (occupation(i) > 1.999d0) then class(0,1) += 1 class( class(0,1), 1) = i - else if (occupation(i) > 1.95d0) then + else if (occupation(i) > 1.97d0) then class(0,2) += 1 class( class(0,2), 2) = i else if (occupation(i) < 0.001d0) then class(0,5) += 1 class( class(0,5), 5) = i - else if (occupation(i) < 0.01d0) then + else if (occupation(i) < 0.03d0) then class(0,4) += 1 class( class(0,4), 4) = i else diff --git a/plugins/mrcc_selected/ezfio_interface.irp.f b/plugins/mrcc_selected/ezfio_interface.irp.f index 47e7cea5..54d993fe 100644 --- a/plugins/mrcc_selected/ezfio_interface.irp.f +++ b/plugins/mrcc_selected/ezfio_interface.irp.f @@ -1,6 +1,6 @@ ! DO NOT MODIFY BY HAND ! Created by $QP_ROOT/scripts/ezfio_interface/ei_handler.py -! from file /ccc/work/cont003/gen1738/scemama/quantum_package/src/mrcc_selected/EZFIO.cfg +! from file /panfs/panasas/cnt0024/cpq1738/scemama/workdir/quantum_package/src/mrcc_selected/EZFIO.cfg BEGIN_PROVIDER [ double precision, thresh_dressed_ci ] diff --git a/plugins/mrcepa0/EZFIO.cfg b/plugins/mrcepa0/EZFIO.cfg index a2dc1bb3..53519ec7 100644 --- a/plugins/mrcepa0/EZFIO.cfg +++ b/plugins/mrcepa0/EZFIO.cfg @@ -18,7 +18,7 @@ interface: ezfio type: logical doc: Compute perturbative contribution of the Triples interface: ezfio,provider,ocaml -default: true +default: false [energy] type: double precision diff --git a/plugins/mrcepa0/dressing.irp.f b/plugins/mrcepa0/dressing.irp.f index 61443246..d2311676 100644 --- a/plugins/mrcepa0/dressing.irp.f +++ b/plugins/mrcepa0/dressing.irp.f @@ -38,7 +38,7 @@ use bitmasks do p=hh_shortcut(h), hh_shortcut(h+1)-1 call apply_particle_local(mask, pp_exists(1, p), buf(1,1,n), ok, N_int) if(ok) n = n + 1 - if(n > N_det_non_ref) stop "MRCC..." + if(n > N_det_non_ref) stop "Buffer too small in MRCC..." end do n = n - 1 diff --git a/scripts/ezfio_interface/qp_convert_output_to_ezfio.py b/scripts/ezfio_interface/qp_convert_output_to_ezfio.py index 6823df81..0c5e1b37 100755 --- a/scripts/ezfio_interface/qp_convert_output_to_ezfio.py +++ b/scripts/ezfio_interface/qp_convert_output_to_ezfio.py @@ -3,7 +3,7 @@ convert output of gamess/GAU$$IAN to ezfio Usage: - qp_convert_output_to_ezfio.py [--ezfio=] + qp_convert_output_to_ezfio.py [-o ] Option: file.out is the file to check (like gamess.out) @@ -272,7 +272,7 @@ def write_ezfio(res, filename): # # INPUT - # {% for lanel,zcore, l_block in l_atom $} + # {% for label,zcore, l_block in l_atom $} # #local l_block l=0} # {label} GEN {zcore} {len(l_block)-1 #lmax_block} # {% for l_param in l_block%} @@ -280,6 +280,7 @@ def write_ezfio(res, filename): # {% for coef,n,zeta for l_param} # {coef,n, zeta} + # OUTPUT # Local are 1 array padded by max(n_max_block) when l == 0 (output:k_loc_max) @@ -309,8 +310,16 @@ def write_ezfio(res, filename): array_l_max_block.append(l_max_block) array_z_remove.append(z_remove) - matrix.append([[coef_n_zeta.split()[1:] for coef_n_zeta in l.split('\n')] for l in array_party[1:]]) - + x = [[coef_n_zeta.split() for coef_n_zeta in l.split('\n')] \ + for l in array_party[1:] ] + x = [] + for l in array_party[1:]: + y = [] + for coef_n_zeta in l.split('\n'): + z = coef_n_zeta.split() + if z : y.append(z) + x.append(y) + matrix.append(x) return (matrix, array_l_max_block, array_z_remove) def get_local_stuff(matrix): @@ -319,7 +328,6 @@ def write_ezfio(res, filename): k_loc_max = max(len(i) for i in matrix_local_unpad) matrix_local = [ pad(ll, k_loc_max, [0., 2, 0.]) for ll in matrix_local_unpad] - m_coef = [[float(i[0]) for i in atom] for atom in matrix_local] m_n = [[int(i[1]) - 2 for i in atom] for atom in matrix_local] m_zeta = [[float(i[2]) for i in atom] for atom in matrix_local] @@ -343,9 +351,20 @@ def write_ezfio(res, filename): return (l_max_block, k_max, m_coef_noloc, m_n_noloc, m_zeta_noloc) try: - pseudo_str = res_file.get_pseudo() + pseudo_str = [] + label = ezfio.get_nuclei_nucl_label() + for ecp in res.pseudo: + pseudo_str += [ "%(label)s GEN %(zcore)d %(lmax)d" % { "label": label[ ecp["atom"]-1 ], + "zcore": ecp["zcore"], "lmax": ecp["lmax"] } ] + lmax = ecp["lmax"] + for l in [lmax] + list(range(0,lmax)): + pseudo_str += [ "%d"%len(ecp[str(l)]) ] + for t in ecp[str(l)]: + pseudo_str += [ "%f %d %f"%t ] + pseudo_str += [""] + pseudo_str = "\n".join(pseudo_str) + matrix, array_l_max_block, array_z_remove = parse_str(pseudo_str) - except: ezfio.set_pseudo_do_pseudo(False) else: @@ -359,10 +378,12 @@ def write_ezfio(res, filename): ezfio.nuclei_nucl_charge = [i - j for i, j in zip(ezfio.nuclei_nucl_charge, array_z_remove)] import math - num_elec = sum(ezfio.nuclei_nucl_charge) + num_elec_diff = sum(array_z_remove)/2 + nalpha = ezfio.get_electrons_elec_alpha_num() - num_elec_diff + nbeta = ezfio.get_electrons_elec_beta_num() - num_elec_diff - ezfio.electrons_elec_alpha_num = int(math.ceil(num_elec / 2.)) - ezfio.electrons_elec_beta_num = int(math.floor(num_elec / 2.)) + ezfio.set_electrons_elec_alpha_num(nalpha) + ezfio.set_electrons_elec_beta_num( nbeta ) # Change all the array 'cause EZFIO # v_kl (v, l) => v_kl(l,v) @@ -408,8 +429,8 @@ if __name__ == '__main__': file_ = get_full_path(arguments['']) - if arguments["--ezfio"]: - ezfio_file = get_full_path(arguments["--ezfio"]) + if arguments["-o"]: + ezfio_file = get_full_path(arguments[""]) else: ezfio_file = "{0}.ezfio".format(file_) @@ -421,3 +442,4 @@ if __name__ == '__main__': print file_, 'recognized as', str(res_file).split('.')[-1].split()[0] write_ezfio(res_file, ezfio_file) + os.system("qp_run save_ortho_mos "+ezfio_file) diff --git a/scripts/ezfio_interface/qp_edit_template b/scripts/ezfio_interface/qp_edit_template index 9c7a1386..af9b295c 100644 --- a/scripts/ezfio_interface/qp_edit_template +++ b/scripts/ezfio_interface/qp_edit_template @@ -1,6 +1,10 @@ -open Qputils;; -open Qptypes;; -open Core.Std;; +(* + vim::syntax=ocaml + *) + +open Qputils +open Qptypes +open Core.Std (** Interactive editing of the input. @@ -18,7 +22,7 @@ type keyword = | Mo_basis | Nuclei {keywords} -;; + let keyword_to_string = function @@ -28,7 +32,7 @@ let keyword_to_string = function | Mo_basis -> "MO basis" | Nuclei -> "Molecule" {keywords_to_string} -;; + @@ -42,7 +46,7 @@ let file_header filename = Editing file `%s` " filename -;; + (** Creates the header of a section *) @@ -50,7 +54,7 @@ let make_header kw = let s = keyword_to_string kw in let l = String.length s in "\n\n"^s^"\n"^(String.init l ~f:(fun _ -> '='))^"\n\n" -;; + (** Returns the rst string of section [s] *) @@ -82,7 +86,7 @@ let get s = | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "") in rst -;; + (** Applies the changes from the string [str] corresponding to section [s] *) @@ -121,7 +125,7 @@ let set str s = | Ao_basis -> () (* TODO *) | Mo_basis -> () (* TODO *) end -;; + (** Creates the temporary file for interactive editing *) @@ -135,11 +139,19 @@ let create_temp_file ezfio_filename fields = ) end ; temp_filename -;; + -let run check_only ezfio_filename = + +let run check_only ?ndet ?state ezfio_filename = + + (* Set check_only if the arguments are not empty *) + let check_only = + match ndet, state with + | None, None -> check_only + | _ -> true + in (* Open EZFIO *) if (not (Sys.file_exists_exn ezfio_filename)) then @@ -147,6 +159,19 @@ let run check_only ezfio_filename = Ezfio.set_file ezfio_filename; + begin + match ndet with + | None -> () + | Some n -> Input.Determinants_by_hand.update_ndet (Det_number.of_int n) + end; + + begin + match state with + | None -> () + | Some n -> Input.Determinants_by_hand.extract_state (States_number.of_int n) + end; + + (* let output = (file_header ezfio_filename) :: ( List.map ~f:get [ @@ -196,7 +221,7 @@ let run check_only ezfio_filename = (* Remove temp_file *) Sys.remove temp_filename -;; + (** Create a backup file in case of an exception *) @@ -207,7 +232,7 @@ let create_backup ezfio_filename = " ezfio_filename ezfio_filename ezfio_filename |> Sys.command_exn -;; + (** Restore the backup file when an exception occuprs *) @@ -215,7 +240,7 @@ let restore_backup ezfio_filename = Printf.sprintf "tar -zxf %s/backup.tgz" ezfio_filename |> Sys.command_exn -;; + let spec = @@ -223,12 +248,12 @@ let spec = empty +> flag "-c" no_arg ~doc:"Checks the input data" -(* - +> flag "o" (optional string) - ~doc:"Prints output data" -*) + +> flag "ndet" (optional int) + ~doc:"int Truncate the wavefunction to the target number of determinants" + +> flag "state" (optional int) + ~doc:"int Pick the state as a new wavefunction." +> anon ("ezfio_file" %: string) -;; + let command = Command.basic @@ -245,9 +270,9 @@ Edit input data with | _ msg -> print_string ("\n\nError\n\n"^msg^"\n\n") *) - (fun c ezfio_file () -> + (fun c ndet state ezfio_file () -> try - run c ezfio_file ; + run c ?ndet ?state ezfio_file ; (* create_backup ezfio_file; *) with | Failure exc @@ -268,12 +293,12 @@ Edit input data raise e end ) -;; + let () = Command.run command; exit 0 -;; + diff --git a/src/AO_Basis/ao_overlap.irp.f b/src/AO_Basis/ao_overlap.irp.f index edf48b25..08e57f73 100644 --- a/src/AO_Basis/ao_overlap.irp.f +++ b/src/AO_Basis/ao_overlap.irp.f @@ -129,3 +129,48 @@ BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num_align,ao_num) ] !$OMP END PARALLEL DO END_PROVIDER +BEGIN_PROVIDER [ double precision, ao_overlap_inv, (ao_num_align, ao_num) ] + implicit none + BEGIN_DOC + ! Inverse of the overlap matrix + END_DOC + call invert_matrix(ao_overlap, size(ao_overlap,1), ao_num, ao_overlap_inv, size(ao_overlap_inv,1)) +END_PROVIDER + +BEGIN_PROVIDER [double precision, ao_overlap_inv_1_2, (ao_num_align,ao_num)] + implicit none + integer :: i,j,k,l + double precision :: eigvalues(ao_num),eigvectors(ao_num_align, ao_num) + call lapack_diag(eigvalues,eigvectors,ao_overlap,ao_num_align,ao_num) + ao_overlap_inv_1_2 = 0.d0 + double precision :: a_n + do i = 1, ao_num + a_n = 1.d0/dsqrt(eigvalues(i)) + if(a_n.le.1.d-10)cycle + do j = 1, ao_num + do k = 1, ao_num + ao_overlap_inv_1_2(k,j) += eigvectors(k,i) * eigvectors(j,i) * a_n + enddo + enddo + enddo + +END_PROVIDER + + +BEGIN_PROVIDER [double precision, ao_overlap_1_2, (ao_num_align,ao_num)] + implicit none + integer :: i,j,k,l + double precision :: eigvalues(ao_num),eigvectors(ao_num_align, ao_num) + call lapack_diag(eigvalues,eigvectors,ao_overlap,ao_num_align,ao_num) + ao_overlap_1_2 = 0.d0 + double precision :: a_n + do i = 1, ao_num + a_n = dsqrt(eigvalues(i)) + do j = 1, ao_num + do k = 1, ao_num + ao_overlap_1_2(k,j) += eigvectors(k,i) * eigvectors(j,i) * a_n + enddo + enddo + enddo + +END_PROVIDER diff --git a/src/Bitmask/bitmasks.irp.f b/src/Bitmask/bitmasks.irp.f index 10ab6f67..e50cf25a 100644 --- a/src/Bitmask/bitmasks.irp.f +++ b/src/Bitmask/bitmasks.irp.f @@ -2,11 +2,16 @@ use bitmasks BEGIN_PROVIDER [ integer, N_int ] implicit none + include 'Utils/constants.include.F' BEGIN_DOC ! Number of 64-bit integers needed to represent determinants as binary strings END_DOC N_int = (mo_tot_num-1)/bit_kind_size + 1 - call write_int(6,N_int, 'N_int') + call write_int(6,N_int, 'N_int') + if (N_int > N_int_max) then + stop 'N_int > N_int_max' + endif + END_PROVIDER diff --git a/src/Davidson/diagonalization.irp.f b/src/Davidson/diagonalization.irp.f index 9bbd00f5..fe82a8fb 100644 --- a/src/Davidson/diagonalization.irp.f +++ b/src/Davidson/diagonalization.irp.f @@ -355,7 +355,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia write(iunit,'(A)') trim(write_buffer) write_buffer = ' Iter' do i=1,N_st - write_buffer = trim(write_buffer)//' Energy Residual' + write_buffer = trim(write_buffer)//' Energy Residual' enddo write(iunit,'(A)') trim(write_buffer) write_buffer = '===== ' @@ -502,7 +502,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,N_st_dia endif enddo - write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))') iter, to_print(:,1:N_st) + write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,E16.6))') iter, to_print(:,1:N_st) call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) if (converged) then exit diff --git a/src/Davidson/diagonalization_hs2.irp.f b/src/Davidson/diagonalization_hs2.irp.f index f458e32d..bf56855a 100644 --- a/src/Davidson/diagonalization_hs2.irp.f +++ b/src/Davidson/diagonalization_hs2.irp.f @@ -413,7 +413,7 @@ subroutine davidson_diag_hjj_sjj(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sze,N_s endif enddo - write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,1:N_st) + write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter, to_print(1:3,1:N_st) call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) do k=1,N_st if (residual_norm(k) > 1.e8) then @@ -838,7 +838,7 @@ subroutine davidson_diag_hjj_sjj_mmap(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz endif enddo - write(iunit,'(X,I3,X,100(X,F16.10,X,F11.6,X,E11.3))') iter, to_print(1:3,1:N_st) + write(iunit,'(1X,I3,1X,100(1X,F16.10,1X,F11.6,1X,E11.3))') iter, to_print(1:3,1:N_st) call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_st,converged) do k=1,N_st if (residual_norm(k) > 1.e8) then diff --git a/src/Davidson/u0Hu0.irp.f b/src/Davidson/u0Hu0.irp.f index 8ef574d4..b096d407 100644 --- a/src/Davidson/u0Hu0.irp.f +++ b/src/Davidson/u0Hu0.irp.f @@ -90,7 +90,7 @@ subroutine H_u_0_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,N_st,sze_8) enddo !$OMP END DO - !$OMP DO SCHEDULE(guided) + !$OMP DO SCHEDULE(static,1) do sh=1,shortcut(0,2) do i=shortcut(sh,2),shortcut(sh+1,2)-1 org_i = sort_idx(i,2) @@ -123,7 +123,7 @@ subroutine H_u_0_nstates(v_0,u_0,H_jj,n,keys_tmp,Nint,N_st,sze_8) enddo !$OMP END DO - !$OMP DO SCHEDULE(guided) + !$OMP DO SCHEDULE(static,1) do sh=1,shortcut(0,1) do sh2=1,shortcut(0,1) if (sh==sh2) cycle @@ -342,7 +342,7 @@ subroutine H_S2_u_0_nstates_zmq(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_ ! istep = 1+ int(workload*target_workload_inv) istep = 1 do blockb2=0, istep-1 - write(tmp_task,'(3(I9,X),''|'',X)') sh, blockb2, istep + write(tmp_task,'(3(I9,1X),''|'',1X)') sh, blockb2, istep task = task//tmp_task ipos += 32 if (ipos+32 > iposmax) then @@ -444,7 +444,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) enddo !$OMP END DO - !$OMP DO SCHEDULE(guided) + !$OMP DO SCHEDULE(static,4) do sh=1,shortcut(0,2) do i=shortcut(sh,2),shortcut(sh+1,2)-1 org_i = sort_idx(i,2) @@ -477,7 +477,7 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) enddo !$OMP END DO - !$OMP DO SCHEDULE(guided) + !$OMP DO SCHEDULE(static,4) do sh=1,shortcut(0,1) do sh2=1,shortcut(0,1) if (sh==sh2) cycle @@ -609,3 +609,352 @@ subroutine H_S2_u_0_nstates(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) deallocate (shortcut, sort_idx, sorted, version, ut) end + + + + +subroutine H_S2_u_0_nstates_new(v_0,s_0,N_st,sze_8) + use bitmasks + implicit none + BEGIN_DOC + ! Computes v_0 = H|u_0> and s_0 = S^2 |u_0> + ! + ! n : number of determinants + ! + ! H_jj : array of + ! + ! S2_jj : array of + END_DOC + integer, intent(in) :: N_st,sze_8 + double precision, intent(out) :: v_0(sze_8,N_st), s_0(sze_8,N_st) + + + PROVIDE ref_bitmask_energy + + double precision :: hij, s2 + integer :: i,j + integer :: k_a, k_b, l_a, l_b, m_a, m_b + integer :: degree, istate + integer :: krow, kcol, krow_b, kcol_b + integer :: lrow, lcol + integer :: mrow, mcol + integer(bit_kind) :: spindet(N_int) + integer(bit_kind) :: tmp_det(N_int,2) + integer(bit_kind) :: tmp_det2(N_int,2) + integer(bit_kind) :: tmp_det3(N_int,2) + integer(bit_kind), allocatable :: buffer(:,:) + double precision :: ck(N_st), cl(N_st), cm(N_st) + integer :: n_singles, n_doubles + integer, allocatable :: singles(:), doubles(:) + integer, allocatable :: idx(:), idx0(:) + logical, allocatable :: is_single_a(:) + + allocate( buffer(N_int,N_det_alpha_unique), & + singles(N_det_alpha_unique), doubles(N_det_alpha_unique), & + is_single_a(N_det_alpha_unique), & + idx(N_det_alpha_unique), idx0(N_det_alpha_unique) ) + + v_0 = 0.d0 + + do k_a=1,N_det-1 + + ! Initial determinant is at k_a in alpha-major representation + ! ----------------------------------------------------------------------- + + krow = psi_bilinear_matrix_rows(k_a) + kcol = psi_bilinear_matrix_columns(k_a) + + tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int, krow) + tmp_det(1:N_int,2) = psi_det_beta_unique (1:N_int, kcol) + + ! Initial determinant is at k_b in beta-major representation + ! ---------------------------------------------------------------------- + + k_b = psi_bilinear_matrix_order_reverse(k_a) + + ! Diagonal contribution + ! --------------------- + + double precision, external :: diag_H_mat_elem + + v_0(k_a,1:N_st) = v_0(k_a,1:N_st) + diag_H_mat_elem(tmp_det,N_int) * & + psi_bilinear_matrix_values(k_a,1:N_st) + + + ! Get all single and double alpha excitations + ! =========================================== + + spindet(1:N_int) = tmp_det(1:N_int,1) + + ! Loop inside the beta column to gather all the connected alphas + i=1 + l_a = k_a+1 + lcol = psi_bilinear_matrix_columns(l_a) + do while ( (lcol == kcol).and.(l_a <= N_det) ) + lrow = psi_bilinear_matrix_rows(l_a) + buffer(1:N_int,i) = psi_det_alpha_unique(1:N_int, lrow) + idx(i) = lrow + i=i+1 + l_a = l_a + 1 + lcol = psi_bilinear_matrix_columns(l_a) + enddo + i = i-1 + + call get_all_spin_singles_and_doubles( & + buffer, idx, spindet, N_int, i, & + singles, doubles, n_singles, n_doubles ) + + ! Compute Hij for all alpha singles + ! ---------------------------------- + + l_a = k_a + lrow = psi_bilinear_matrix_rows(l_a) + tmp_det2(1:N_int,2) = psi_det_beta_unique (1:N_int, kcol) + do i=1,n_singles + do while ( lrow < singles(i) ) + l_a = l_a+1 + lrow = psi_bilinear_matrix_rows(l_a) + enddo + tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, lrow) + call i_H_j_mono_spin( tmp_det, tmp_det2, N_int, 1, hij) + v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st) + v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st) + enddo + + ! Compute Hij for all alpha doubles + ! ---------------------------------- + + l_a = k_a + lrow = psi_bilinear_matrix_rows(l_a) + do i=1,n_doubles + do while (lrow < doubles(i)) + l_a = l_a+1 + lrow = psi_bilinear_matrix_rows(l_a) + enddo + call i_H_j_double_spin( tmp_det(1,1), psi_det_alpha_unique(1, doubles(i)), N_int, hij) + v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st) + v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st) + enddo + + + + ! Get all single and double beta excitations + ! =========================================== + + spindet(1:N_int) = tmp_det(1:N_int,2) + + ! Loop inside the alpha row to gather all the connected betas + i=1 + l_b = k_b+1 + lrow = psi_bilinear_matrix_transp_rows(l_b) + do while ( (lrow == krow).and.(l_b <= N_det) ) + lcol = psi_bilinear_matrix_transp_columns(l_b) + buffer(1:N_int,i) = psi_det_beta_unique(1:N_int, lcol) + idx(i) = lcol + i=i+1 + l_b = l_b + 1 + lrow = psi_bilinear_matrix_transp_rows(l_b) + enddo + i = i-1 + + call get_all_spin_singles_and_doubles( & + buffer, idx, spindet, N_int, i, & + singles, doubles, n_singles, n_doubles ) + + ! Compute Hij for all beta singles + ! ---------------------------------- + + l_b = k_b + lcol = psi_bilinear_matrix_transp_columns(l_b) + tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int, krow) + do i=1,n_singles + do while ( lcol < singles(i) ) + l_b = l_b+1 + lcol = psi_bilinear_matrix_transp_columns(l_b) + enddo + tmp_det2(1:N_int,2) = psi_det_beta_unique (1:N_int, lcol) + l_a = psi_bilinear_matrix_transp_order(l_b) + call i_H_j_mono_spin( tmp_det, tmp_det2, N_int, 2, hij) + v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st) + v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st) + enddo + + ! Compute Hij for all beta doubles + ! ---------------------------------- + + l_b = k_b + lcol = psi_bilinear_matrix_transp_columns(l_b) + do i=1,n_doubles + do while (lcol < doubles(i)) + l_b = l_b+1 + lcol = psi_bilinear_matrix_transp_columns(l_b) + enddo + l_a = psi_bilinear_matrix_transp_order(l_b) + call i_H_j_double_spin( tmp_det(1,2), psi_det_beta_unique(1, doubles(i)), N_int, hij) + v_0(l_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st) + v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(l_a,1:N_st) + enddo + + end do + + + ! Alpha/Beta double excitations + ! ============================= + + do i=1,N_det_beta_unique + idx0(i) = i + enddo + is_single_a(:) = .False. + + k_a=1 + do i=1,N_det_beta_unique + + ! Select a beta determinant + ! ------------------------- + + spindet(1:N_int) = psi_det_beta_unique(1:N_int, i) + tmp_det(1:N_int,2) = spindet(1:N_int) + + call get_all_spin_singles( & + psi_det_beta_unique, idx0, spindet, N_int, N_det_beta_unique, & + singles, n_singles ) + + do j=1,n_singles + is_single_a( singles(j) ) = .True. + enddo + + ! For all alpha.beta pairs with the selected beta + ! ----------------------------------------------- + + kcol = psi_bilinear_matrix_columns(k_a) + do while (kcol < i) + k_a = k_a+1 + if (k_a > N_det) exit + kcol = psi_bilinear_matrix_columns(k_a) + enddo + + do while (kcol == i) + + krow = psi_bilinear_matrix_rows(k_a) + tmp_det(1:N_int,1) = psi_det_alpha_unique(1:N_int,krow) + + ! Loop over all alpha.beta pairs with a single exc alpha + ! ------------------------------------------------------ + + l_a = k_a+1 + if (l_a > N_det) exit + lrow = psi_bilinear_matrix_rows(l_a) + lcol = psi_bilinear_matrix_columns(l_a) + + do while (lrow == krow) + + ! Loop over all alpha.beta pairs with a single exc alpha + ! ------------------------------------------------------ + if (is_single_a(lrow)) then + + tmp_det2(1:N_int,1) = psi_det_alpha_unique(1:N_int,lrow) + + ! Build list of singly excited beta + ! --------------------------------- + + m_b = psi_bilinear_matrix_order_reverse(l_a) + m_b = m_b+1 + j=1 + do while ( (mrow == lrow) ) + mcol = psi_bilinear_matrix_transp_columns(m_b) + buffer(1:N_int,j) = psi_det_beta_unique(1:N_int,mcol) + idx(j) = mcol + j = j+1 + m_b = m_b+1 + if (m_b <= N_det) exit + mrow = psi_bilinear_matrix_transp_rows(m_b) + enddo + j=j-1 + + call get_all_spin_singles( & + buffer, idx, tmp_det(1,2), N_int, j, & + doubles, n_doubles) + + ! Compute Hij for all doubles + ! --------------------------- + + m_b = psi_bilinear_matrix_order(l_a)+1 + mcol = psi_bilinear_matrix_transp_columns(m_b) + do j=1,n_doubles + tmp_det2(1:N_int,2) = psi_det_beta_unique(1:N_int, doubles(j) ) + call i_H_j_double_alpha_beta(tmp_det,tmp_det2,N_int,hij) + do while (mcol /= doubles(j)) + m_b = m_b+1 + if (m_b > N_det) exit + mcol = psi_bilinear_matrix_transp_columns(m_b) + enddo + m_a = psi_bilinear_matrix_order_reverse(m_b) +! v_0(m_a, 1:N_st) += hij * psi_bilinear_matrix_values(k_a,1:N_st) +! v_0(k_a, 1:N_st) += hij * psi_bilinear_matrix_values(m_a,1:N_st) + enddo + + endif + l_a = l_a+1 + if (l_a > N_det) exit + lrow = psi_bilinear_matrix_rows(l_a) + lcol = psi_bilinear_matrix_columns(l_a) + enddo + + k_b = k_b+1 + if (k_b > N_det) exit + kcol = psi_bilinear_matrix_transp_columns(k_b) + enddo + + do j=1,n_singles + is_single_a( singles(j) ) = .False. + enddo + + enddo + + +end + + +subroutine H_S2_u_0_nstates_test(v_0,s_0,u_0,H_jj,S2_jj,n,keys_tmp,Nint,N_st,sze_8) + use bitmasks + implicit none + integer, intent(in) :: N_st,n,Nint, sze_8 + integer(bit_kind), intent(in) :: keys_tmp(Nint,2,n) + double precision, intent(out) :: v_0(sze_8,N_st), s_0(sze_8,N_st) + double precision, intent(in) :: u_0(sze_8,N_st) + double precision, intent(in) :: H_jj(n), S2_jj(n) + + PROVIDE ref_bitmask_energy + + double precision, allocatable :: vt(:,:) + integer, allocatable :: idx(:) + integer :: i,j, jj + double precision :: hij + + do i=1,n + v_0(i,:) = H_jj(i) * u_0(i,:) + enddo + + allocate(idx(0:n), vt(N_st,n)) + Vt = 0.d0 + do i=2,n + idx(0) = i + call filter_connected(keys_tmp,keys_tmp(1,1,i),Nint,i-1,idx) + do jj=1,idx(0) + j = idx(jj) + double precision :: phase + integer :: degree + integer :: exc(0:2,2,2) + call get_excitation(keys_tmp(1,1,j),keys_tmp(1,1,i),exc,degree,phase,Nint) + if ((degree == 2).and.(exc(0,1,1)==1)) cycle +! if (exc(0,1,2) /= 0) cycle + call i_H_j(keys_tmp(1,1,j),keys_tmp(1,1,i),Nint,hij) + vt (:,i) = vt (:,i) + hij*u_0(j,:) + vt (:,j) = vt (:,j) + hij*u_0(i,:) + enddo + enddo + do i=1,n + v_0(i,:) = v_0(i,:) + vt(:,i) + enddo +end + diff --git a/src/Determinants/density_matrix.irp.f b/src/Determinants/density_matrix.irp.f index 41433ed1..7274760e 100644 --- a/src/Determinants/density_matrix.irp.f +++ b/src/Determinants/density_matrix.irp.f @@ -78,96 +78,68 @@ END_PROVIDER double precision :: ck, cl, ckl double precision :: phase integer :: h1,h2,p1,p2,s1,s2, degree - integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int,2) - integer :: exc(0:2,2,2),n_occ(2) + integer(bit_kind) :: tmp_det(N_int,2), tmp_det2(N_int) + integer :: exc(0:2,2),n_occ(2) double precision, allocatable :: tmp_a(:,:,:), tmp_b(:,:,:) integer :: krow, kcol, lrow, lcol - one_body_dm_mo_alpha = 0.d0 - one_body_dm_mo_beta = 0.d0 - !$OMP PARALLEL DEFAULT(NONE) & - !$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, & - !$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2)& - !$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,& - !$OMP elec_beta_num,one_body_dm_mo_alpha,one_body_dm_mo_beta,N_det,mo_tot_num_align,& - !$OMP mo_tot_num,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns, & - !$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns, & - !$OMP psi_bilinear_matrix_values, psi_bilinear_matrix_transp_values) - allocate(tmp_a(mo_tot_num_align,mo_tot_num,N_states), tmp_b(mo_tot_num_align,mo_tot_num,N_states) ) - tmp_a = 0.d0 - tmp_b = 0.d0 - !$OMP DO SCHEDULE(guided) - do k=1,N_det - krow = psi_bilinear_matrix_rows(k) - kcol = psi_bilinear_matrix_columns(k) - tmp_det(:,1) = psi_det(:,1, krow) - tmp_det(:,2) = psi_det(:,2, kcol) - call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int) - do m=1,N_states - ck = psi_bilinear_matrix_values(k,m)*psi_bilinear_matrix_values(k,m) - do l=1,elec_alpha_num - j = occ(l,1) - tmp_a(j,j,m) += ck - enddo - do l=1,elec_beta_num - j = occ(l,2) - tmp_b(j,j,m) += ck - enddo - enddo + PROVIDE psi_det - l = k+1 - lrow = psi_bilinear_matrix_rows(l) - lcol = psi_bilinear_matrix_columns(l) - do while ( lcol == kcol ) - tmp_det2(:,1) = psi_det(:,1, lrow) - tmp_det2(:,2) = psi_det(:,2, lcol) - call get_excitation_degree(tmp_det,tmp_det2,degree,N_int) - if (degree == 1) then - call get_mono_excitation(psi_det(1,1,k),psi_det(1,1,l),exc,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - do m=1,N_states - ckl = psi_bilinear_matrix_values(k,m)*psi_bilinear_matrix_values(l,m) * phase - if (s1==1) then - tmp_a(h1,p1,m) += ckl - tmp_a(p1,h1,m) += ckl - else - tmp_b(h1,p1,m) += ckl - tmp_b(p1,h1,m) += ckl - endif - enddo - endif - l = l+1 - if (l>N_det) exit - lrow = psi_bilinear_matrix_rows(l) - lcol = psi_bilinear_matrix_columns(l) - enddo + one_body_dm_mo_alpha = 0.d0 + one_body_dm_mo_beta = 0.d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, & + !$OMP tmp_a, tmp_b, n_occ, krow, kcol, lrow, lcol, tmp_det, tmp_det2)& + !$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,& + !$OMP elec_beta_num,one_body_dm_mo_alpha,one_body_dm_mo_beta,N_det,mo_tot_num_align,& + !$OMP mo_tot_num,psi_bilinear_matrix_rows,psi_bilinear_matrix_columns, & + !$OMP psi_bilinear_matrix_transp_rows, psi_bilinear_matrix_transp_columns, & + !$OMP psi_bilinear_matrix_order_reverse, psi_det_alpha_unique, psi_det_beta_unique, & + !$OMP psi_bilinear_matrix_values, psi_bilinear_matrix_transp_values) + allocate(tmp_a(mo_tot_num_align,mo_tot_num,N_states), tmp_b(mo_tot_num_align,mo_tot_num,N_states) ) + tmp_a = 0.d0 + tmp_b = 0.d0 + !$OMP DO SCHEDULE(guided) + do k=1,N_det + krow = psi_bilinear_matrix_rows(k) + kcol = psi_bilinear_matrix_columns(k) + tmp_det(:,1) = psi_det_alpha_unique(:,krow) + tmp_det(:,2) = psi_det_beta_unique (:,kcol) + call bitstring_to_list_ab(tmp_det, occ, n_occ, N_int) + do m=1,N_states + ck = psi_bilinear_matrix_values(k,m)*psi_bilinear_matrix_values(k,m) + do l=1,elec_alpha_num + j = occ(l,1) + tmp_a(j,j,m) += ck + enddo + do l=1,elec_beta_num + j = occ(l,2) + tmp_b(j,j,m) += ck + enddo + enddo - l = k+1 - lrow = psi_bilinear_matrix_transp_rows(l) - lcol = psi_bilinear_matrix_transp_columns(l) - do while ( lrow == krow ) - tmp_det2(:,1) = psi_det(:,1, lrow) - tmp_det2(:,2) = psi_det(:,2, lcol) - call get_excitation_degree(tmp_det,tmp_det2,degree,N_int) - if (degree == 1) then - call get_mono_excitation(psi_det(1,1,k),psi_det(1,1,l),exc,phase,N_int) - call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) - do m=1,N_states - ckl = psi_bilinear_matrix_values(k,m)*psi_bilinear_matrix_transp_values(l,m) * phase - if (s1==1) then - tmp_a(h1,p1,m) += ckl - tmp_a(p1,h1,m) += ckl - else - tmp_b(h1,p1,m) += ckl - tmp_b(p1,h1,m) += ckl - endif - enddo - endif - l = l+1 - if (l>N_det) exit - lrow = psi_bilinear_matrix_transp_rows(l) - lcol = psi_bilinear_matrix_transp_columns(l) - enddo + l = k+1 + lrow = psi_bilinear_matrix_rows(l) + lcol = psi_bilinear_matrix_columns(l) + ! Fix beta determinant, loop over alphas + do while ( lcol == kcol ) + tmp_det2(:) = psi_det_alpha_unique(:, lrow) + call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int) + if (degree == 1) then + exc = 0 + call get_mono_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int) + call decode_exc_spin(exc,h1,p1,h2,p2) + do m=1,N_states + ckl = psi_bilinear_matrix_values(k,m)*psi_bilinear_matrix_values(l,m) * phase + tmp_a(h1,p1,m) += ckl + tmp_a(p1,h1,m) += ckl + enddo + endif + l = l+1 + if (l>N_det) exit + lrow = psi_bilinear_matrix_rows(l) + lcol = psi_bilinear_matrix_columns(l) + enddo enddo !$OMP END DO NOWAIT @@ -364,3 +336,74 @@ END_PROVIDER END_PROVIDER + + BEGIN_PROVIDER [ double precision, one_body_dm_mo_alpha_old, (mo_tot_num_align,mo_tot_num,N_states) ] +&BEGIN_PROVIDER [ double precision, one_body_dm_mo_beta_old, (mo_tot_num_align,mo_tot_num,N_states) ] + implicit none + BEGIN_DOC + ! Alpha and beta one-body density matrix for each state + END_DOC + + integer :: j,k,l,m + integer :: occ(N_int*bit_kind_size,2) + double precision :: ck, cl, ckl + double precision :: phase + integer :: h1,h2,p1,p2,s1,s2, degree + integer :: exc(0:2,2,2),n_occ(2) + double precision, allocatable :: tmp_a(:,:,:), tmp_b(:,:,:) + + one_body_dm_mo_alpha_old = 0.d0 + one_body_dm_mo_beta_old = 0.d0 + !$OMP PARALLEL DEFAULT(NONE) & + !$OMP PRIVATE(j,k,l,m,occ,ck, cl, ckl,phase,h1,h2,p1,p2,s1,s2, degree,exc, & + !$OMP tmp_a, tmp_b, n_occ)& + !$OMP SHARED(psi_det,psi_coef,N_int,N_states,elec_alpha_num,& + !$OMP elec_beta_num,one_body_dm_mo_alpha_old,one_body_dm_mo_beta_old,N_det,mo_tot_num_align,& + !$OMP mo_tot_num) + allocate(tmp_a(mo_tot_num_align,mo_tot_num,N_states), tmp_b(mo_tot_num_align,mo_tot_num,N_states) ) + tmp_a = 0.d0 + tmp_b = 0.d0 + !$OMP DO SCHEDULE(dynamic) + do k=1,N_det + call bitstring_to_list_ab(psi_det(1,1,k), occ, n_occ, N_int) + do m=1,N_states + ck = psi_coef(k,m)*psi_coef(k,m) + do l=1,elec_alpha_num + j = occ(l,1) + tmp_a(j,j,m) += ck + enddo + do l=1,elec_beta_num + j = occ(l,2) + tmp_b(j,j,m) += ck + enddo + enddo + do l=1,k-1 + call get_excitation_degree(psi_det(1,1,k),psi_det(1,1,l),degree,N_int) + if (degree /= 1) then + cycle + endif + call get_mono_excitation(psi_det(1,1,k),psi_det(1,1,l),exc,phase,N_int) + call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) + do m=1,N_states + ckl = psi_coef(k,m) * psi_coef(l,m) * phase + if (s1==1) then + tmp_a(h1,p1,m) += ckl + tmp_a(p1,h1,m) += ckl + else + tmp_b(h1,p1,m) += ckl + tmp_b(p1,h1,m) += ckl + endif + enddo + enddo + enddo + !$OMP END DO NOWAIT + !$OMP CRITICAL + one_body_dm_mo_alpha_old(:,:,:) = one_body_dm_mo_alpha_old(:,:,:) + tmp_a(:,:,:) + !$OMP END CRITICAL + !$OMP CRITICAL + one_body_dm_mo_beta_old(:,:,:) = one_body_dm_mo_beta_old(:,:,:) + tmp_b(:,:,:) + !$OMP END CRITICAL + deallocate(tmp_a,tmp_b) + !$OMP END PARALLEL + +END_PROVIDER diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index bed3327d..2644801e 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -23,7 +23,7 @@ BEGIN_PROVIDER [ integer, N_det ] ! Number of determinants in the wave function END_DOC logical :: exists - character*64 :: label + character*(64) :: label PROVIDE ezfio_filename PROVIDE nproc if (read_wf) then @@ -88,7 +88,7 @@ BEGIN_PROVIDER [ integer(bit_kind), psi_det, (N_int,2,psi_det_size) ] END_DOC integer :: i logical :: exists - character*64 :: label + character*(64) :: label psi_det = 0_bit_kind if (read_wf) then diff --git a/src/Determinants/print_wf.irp.f b/src/Determinants/print_wf.irp.f index 737e4d3e..2120a512 100644 --- a/src/Determinants/print_wf.irp.f +++ b/src/Determinants/print_wf.irp.f @@ -32,29 +32,28 @@ subroutine routine call get_excitation(psi_det(1,1,1),psi_det(1,1,i),exc,degree,phase,N_int) call decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) print*,'phase = ',phase -! if(degree == 1)then -! print*,'s1',s1 -! print*,'h1,p1 = ',h1,p1 -! if(s1 == 1)then -! norm_mono_a += dabs(psi_coef(i,1)/psi_coef(1,1)) -! else -! norm_mono_b += dabs(psi_coef(i,1)/psi_coef(1,1)) -! endif + if(degree == 1)then + print*,'s1',s1 + print*,'h1,p1 = ',h1,p1 + if(s1 == 1)then + norm_mono_a += dabs(psi_coef(i,1)/psi_coef(1,1)) + else + norm_mono_b += dabs(psi_coef(i,1)/psi_coef(1,1)) + endif ! print*,'< h | Ka| p > = ',get_mo_bielec_integral(h1,list_act(1),list_act(1),p1,mo_integrals_map) -! double precision :: hmono,hdouble -! call i_H_j_verbose(psi_det(1,1,1),psi_det(1,1,i),N_int,hij,hmono,hdouble) -! print*,'hmono = ',hmono -! print*,'hdouble = ',hdouble -! print*,'hmono+hdouble = ',hmono+hdouble -! print*,'hij = ',hij -! else -! print*,'s1',s1 -! print*,'h1,p1 = ',h1,p1 -! print*,'s2',s2 -! print*,'h2,p2 = ',h2,p2 + double precision :: hmono,hdouble + call i_H_j_verbose(psi_det(1,1,1),psi_det(1,1,i),N_int,hij,hmono,hdouble) + print*,'hmono = ',hmono + print*,'hdouble = ',hdouble + print*,'hmono+hdouble = ',hmono+hdouble + print*,'hij = ',hij + else if (degree == 2)then + print*,'s1',s1 + print*,'h1,p1 = ',h1,p1 + print*,'s2',s2 + print*,'h2,p2 = ',h2,p2 ! print*,'< h | Ka| p > = ',get_mo_bielec_integral(h1,h2,p1,p2,mo_integrals_map) -! endif - + endif print*,' = ',hij endif print*,'amplitude = ',psi_coef(i,1)/psi_coef(1,1) diff --git a/src/Determinants/s2.irp.f b/src/Determinants/s2.irp.f index a807513c..a6e69fb5 100644 --- a/src/Determinants/s2.irp.f +++ b/src/Determinants/s2.irp.f @@ -252,8 +252,8 @@ end subroutine get_uJ_s2_uI(psi_keys_tmp,psi_coefs_tmp,n,nmax_coefs,nmax_keys,s2,nstates) implicit none use bitmasks - integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys) integer, intent(in) :: n,nmax_coefs,nmax_keys,nstates + integer(bit_kind), intent(in) :: psi_keys_tmp(N_int,2,nmax_keys) double precision, intent(in) :: psi_coefs_tmp(nmax_coefs,nstates) double precision, intent(out) :: s2(nstates,nstates) double precision :: s2_tmp,accu @@ -344,7 +344,7 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,u_0,n,nmax_keys,nmax_coefs,nsta print*,'S^2 matrix in the basis of the states considered' do i = 1, nstates - write(*,'(100(F5.2,X))')s2(i,:) + write(*,'(100(F5.2,1X))')s2(i,:) enddo double precision :: accu_precision_diag,accu_precision_of_diag @@ -370,7 +370,7 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,u_0,n,nmax_keys,nmax_coefs,nsta print*,'Modified S^2 matrix that will be diagonalized' do i = 1, nstates - write(*,'(10(F5.2,X))')s2(i,:) + write(*,'(10(F5.2,1X))')s2(i,:) s2(i,i) = s2(i,i) enddo diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 2a76a079..f4af1b60 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -1,32 +1,59 @@ subroutine get_excitation_degree(key1,key2,degree,Nint) use bitmasks + include 'Utils/constants.include.F' implicit none BEGIN_DOC ! Returns the excitation degree between two determinants END_DOC integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: key1(Nint,2) - integer(bit_kind), intent(in) :: key2(Nint,2) + integer(bit_kind), intent(in) :: key1(Nint*2) + integer(bit_kind), intent(in) :: key2(Nint*2) integer, intent(out) :: degree + integer(bit_kind) :: xorvec(2*N_int_max) integer :: l ASSERT (Nint > 0) - degree = popcnt(xor( key1(1,1), key2(1,1))) + & - popcnt(xor( key1(1,2), key2(1,2))) - !DIR$ NOUNROLL - do l=2,Nint - degree = degree+ popcnt(xor( key1(l,1), key2(l,1))) + & - popcnt(xor( key1(l,2), key2(l,2))) - enddo - ASSERT (degree >= 0) + select case (Nint) + + case (1) + xorvec(1) = xor( key1(1), key2(1)) + xorvec(2) = xor( key1(2), key2(2)) + degree = sum(popcnt(xorvec(1:2))) + + case (2) + xorvec(1) = xor( key1(1), key2(1)) + xorvec(2) = xor( key1(2), key2(2)) + xorvec(3) = xor( key1(3), key2(3)) + xorvec(4) = xor( key1(4), key2(4)) + degree = sum(popcnt(xorvec(1:4))) + + case (3) + do l=1,6 + xorvec(l) = xor( key1(l), key2(l)) + enddo + degree = sum(popcnt(xorvec(1:6))) + + case (4) + do l=1,8 + xorvec(l) = xor( key1(l), key2(l)) + enddo + degree = sum(popcnt(xorvec(1:8))) + + case default + do l=1,ishft(Nint,1) + xorvec(l) = xor( key1(l), key2(l)) + enddo + degree = sum(popcnt(xorvec(1:l))) + + end select + degree = ishft(degree,-1) end - subroutine get_excitation(det1,det2,exc,degree,phase,Nint) use bitmasks implicit none @@ -139,72 +166,6 @@ subroutine decode_exc(exc,degree,h1,p1,h2,p2,s1,s2) end -subroutine decode_exc_int2(exc,degree,h1,p1,h2,p2,s1,s2) - use bitmasks - implicit none - BEGIN_DOC - ! Decodes the exc arrays returned by get_excitation. - ! h1,h2 : Holes - ! p1,p2 : Particles - ! s1,s2 : Spins (1:alpha, 2:beta) - ! degree : Degree of excitation - END_DOC - integer, intent(in) :: exc(0:2,2,2),degree - integer*2, intent(out) :: h1,h2,p1,p2,s1,s2 - ASSERT (degree > 0) - ASSERT (degree < 3) - - select case(degree) - case(2) - if (exc(0,1,1) == 2) then - h1 = exc(1,1,1) - h2 = exc(2,1,1) - p1 = exc(1,2,1) - p2 = exc(2,2,1) - s1 = 1 - s2 = 1 - else if (exc(0,1,2) == 2) then - h1 = exc(1,1,2) - h2 = exc(2,1,2) - p1 = exc(1,2,2) - p2 = exc(2,2,2) - s1 = 2 - s2 = 2 - else - h1 = exc(1,1,1) - h2 = exc(1,1,2) - p1 = exc(1,2,1) - p2 = exc(1,2,2) - s1 = 1 - s2 = 2 - endif - case(1) - if (exc(0,1,1) == 1) then - h1 = exc(1,1,1) - h2 = 0 - p1 = exc(1,2,1) - p2 = 0 - s1 = 1 - s2 = 0 - else - h1 = exc(1,1,2) - h2 = 0 - p1 = exc(1,2,2) - p2 = 0 - s1 = 2 - s2 = 0 - endif - case(0) - h1 = 0 - p1 = 0 - h2 = 0 - p2 = 0 - s1 = 0 - s2 = 0 - end select -end - - subroutine get_double_excitation(det1,det2,exc,phase,Nint) use bitmasks implicit none @@ -2154,8 +2115,8 @@ end subroutine get_phase(key1,key2,phase,Nint) use bitmasks implicit none - integer(bit_kind), intent(in) :: key1(Nint,2), key2(Nint,2) integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key1(Nint,2), key2(Nint,2) double precision, intent(out) :: phase BEGIN_DOC ! Returns the phase between key1 and key2 @@ -2224,3 +2185,423 @@ subroutine u_0_H_u_0_stored(e_0,u_0,hmatrix,sze) call matrix_vector_product(u_0,v_0,hmatrix,sze,sze) e_0 = u_dot_v(v_0,u_0,sze) end + + + +! Spin-determinant routines +! ------------------------- + +subroutine get_excitation_degree_spin(key1,key2,degree,Nint) + use bitmasks + include 'Utils/constants.include.F' + implicit none + BEGIN_DOC + ! Returns the excitation degree between two determinants + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key1(Nint) + integer(bit_kind), intent(in) :: key2(Nint) + integer, intent(out) :: degree + + integer(bit_kind) :: xorvec(N_int_max) + integer :: l + + ASSERT (Nint > 0) + + select case (Nint) + + case (1) + xorvec(1) = xor( key1(1), key2(1)) + degree = popcnt(xorvec(1)) + + case (2) + xorvec(1) = xor( key1(1), key2(1)) + xorvec(2) = xor( key1(2), key2(2)) + degree = popcnt(xorvec(1))+popcnt(xorvec(2)) + + case (3) + xorvec(1) = xor( key1(1), key2(1)) + xorvec(2) = xor( key1(2), key2(2)) + xorvec(3) = xor( key1(3), key2(3)) + degree = sum(popcnt(xorvec(1:3))) + + case (4) + xorvec(1) = xor( key1(1), key2(1)) + xorvec(2) = xor( key1(2), key2(2)) + xorvec(3) = xor( key1(3), key2(3)) + xorvec(4) = xor( key1(4), key2(4)) + degree = sum(popcnt(xorvec(1:4))) + + case default + do l=1,N_int + xorvec(l) = xor( key1(l), key2(l)) + enddo + degree = sum(popcnt(xorvec(1:Nint))) + + end select + + degree = ishft(degree,-1) + +end + + +subroutine get_excitation_spin(det1,det2,exc,degree,phase,Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Returns the excitation operators between two determinants and the phase + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: det1(Nint) + integer(bit_kind), intent(in) :: det2(Nint) + integer, intent(out) :: exc(0:2,2) + integer, intent(out) :: degree + double precision, intent(out) :: phase + ! exc(number,hole/particle) + ! ex : + ! exc(0,1) = number of holes + ! exc(0,2) = number of particles + ! exc(1,2) = first particle + ! exc(1,1) = first hole + + ASSERT (Nint > 0) + + !DIR$ FORCEINLINE + call get_excitation_degree_spin(det1,det2,degree,Nint) + select case (degree) + + case (3:) + degree = -1 + return + + case (2) + call get_double_excitation_spin(det1,det2,exc,phase,Nint) + return + + case (1) + call get_mono_excitation_spin(det1,det2,exc,phase,Nint) + return + + case(0) + return + + end select +end + +subroutine decode_exc_spin(exc,h1,p1,h2,p2) + use bitmasks + implicit none + BEGIN_DOC + ! Decodes the exc arrays returned by get_excitation. + ! h1,h2 : Holes + ! p1,p2 : Particles + END_DOC + integer, intent(in) :: exc(0:2,2) + integer, intent(out) :: h1,h2,p1,p2 + + select case (exc(0,1)) + case(2) + h1 = exc(1,1) + h2 = exc(2,1) + p1 = exc(1,2) + p2 = exc(2,2) + case(1) + h1 = exc(1,1) + h2 = 0 + p1 = exc(1,2) + p2 = 0 + case default + h1 = 0 + p1 = 0 + h2 = 0 + p2 = 0 + end select +end + + +subroutine get_double_excitation_spin(det1,det2,exc,phase,Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Returns the two excitation operators between two doubly excited spin-determinants + ! and the phase + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: det1(Nint) + integer(bit_kind), intent(in) :: det2(Nint) + integer, intent(out) :: exc(0:2,2) + double precision, intent(out) :: phase + integer :: tz + integer :: l, idx_hole, idx_particle, ishift + integer :: nperm + integer :: i,j,k,m,n + integer :: high, low + integer :: a,b,c,d + integer(bit_kind) :: hole, particle, tmp + double precision, parameter :: phase_dble(0:1) = (/ 1.d0, -1.d0 /) + + ASSERT (Nint > 0) + nperm = 0 + exc(0,1) = 0 + exc(0,2) = 0 + + idx_particle = 0 + idx_hole = 0 + ishift = 1-bit_kind_size + do l=1,Nint + ishift = ishift + bit_kind_size + if (det1(l) == det2(l)) then + cycle + endif + tmp = xor( det1(l), det2(l) ) + particle = iand(tmp, det2(l)) + hole = iand(tmp, det1(l)) + do while (particle /= 0_bit_kind) + tz = trailz(particle) + idx_particle = idx_particle + 1 + exc(0,2) = exc(0,2) + 1 + exc(idx_particle,2) = tz+ishift + particle = iand(particle,particle-1_bit_kind) + enddo + if (iand(exc(0,1),exc(0,2))==2) then ! exc(0,1)==2 or exc(0,2)==2 + exit + endif + do while (hole /= 0_bit_kind) + tz = trailz(hole) + idx_hole = idx_hole + 1 + exc(0,1) = exc(0,1) + 1 + exc(idx_hole,1) = tz+ishift + hole = iand(hole,hole-1_bit_kind) + enddo + if (iand(exc(0,1),exc(0,2))==2) then ! exc(0,1)==2 or exc(0,2)==2 + exit + endif + enddo + + select case (exc(0,1)) + + case(1) + low = min(exc(1,1), exc(1,2)) + high = max(exc(1,1), exc(1,2)) + + ASSERT (low > 0) + j = ishft(low-1,-bit_kind_shift)+1 ! Find integer in array(Nint) + n = iand(low-1,bit_kind_size-1)+1 ! mod(low,bit_kind_size) + ASSERT (high > 0) + k = ishft(high-1,-bit_kind_shift)+1 + m = iand(high-1,bit_kind_size-1)+1 + + if (j==k) then + nperm = nperm + popcnt(iand(det1(j), & + iand( ibset(0_bit_kind,m-1)-1_bit_kind, & + ibclr(-1_bit_kind,n)+1_bit_kind ) )) + else + nperm = nperm + popcnt(iand(det1(k), & + ibset(0_bit_kind,m-1)-1_bit_kind)) + if (n < bit_kind_size) then + nperm = nperm + popcnt(iand(det1(j), ibclr(-1_bit_kind,n) +1_bit_kind)) + endif + do i=j+1,k-1 + nperm = nperm + popcnt(det1(i)) + end do + endif + + case (2) + + do i=1,2 + low = min(exc(i,1), exc(i,2)) + high = max(exc(i,1), exc(i,2)) + + ASSERT (low > 0) + j = ishft(low-1,-bit_kind_shift)+1 ! Find integer in array(Nint) + n = iand(low-1,bit_kind_size-1)+1 ! mod(low,bit_kind_size) + ASSERT (high > 0) + k = ishft(high-1,-bit_kind_shift)+1 + m = iand(high-1,bit_kind_size-1)+1 + + if (j==k) then + nperm = nperm + popcnt(iand(det1(j), & + iand( ibset(0_bit_kind,m-1)-1_bit_kind, & + ibclr(-1_bit_kind,n)+1_bit_kind ) )) + else + nperm = nperm + popcnt(iand(det1(k), & + ibset(0_bit_kind,m-1)-1_bit_kind)) + if (n < bit_kind_size) then + nperm = nperm + popcnt(iand(det1(j), ibclr(-1_bit_kind,n) +1_bit_kind)) + endif + do l=j+1,k-1 + nperm = nperm + popcnt(det1(l)) + end do + endif + + enddo + + a = min(exc(1,1), exc(1,2)) + b = max(exc(1,1), exc(1,2)) + c = min(exc(2,1), exc(2,2)) + d = max(exc(2,1), exc(2,2)) + if (c>a .and. cb) then + nperm = nperm + 1 + endif + end select + + phase = phase_dble(iand(nperm,1)) + +end + +subroutine get_mono_excitation_spin(det1,det2,exc,phase,Nint) + use bitmasks + implicit none + BEGIN_DOC + ! Returns the excitation operator between two singly excited determinants and the phase + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: det1(Nint) + integer(bit_kind), intent(in) :: det2(Nint) + integer, intent(out) :: exc(0:2,2) + double precision, intent(out) :: phase + integer :: tz + integer :: l, idx_hole, idx_particle, ishift + integer :: nperm + integer :: i,j,k,m,n + integer :: high, low + integer :: a,b,c,d + integer(bit_kind) :: hole, particle, tmp + double precision, parameter :: phase_dble(0:1) = (/ 1.d0, -1.d0 /) + + ASSERT (Nint > 0) + nperm = 0 + exc(0,1) = 0 + exc(0,2) = 0 + + ishift = 1-bit_kind_size + do l=1,Nint + ishift = ishift + bit_kind_size + if (det1(l) == det2(l)) then + cycle + endif + tmp = xor( det1(l), det2(l) ) + particle = iand(tmp, det2(l)) + hole = iand(tmp, det1(l)) + if (particle /= 0_bit_kind) then + tz = trailz(particle) + exc(0,2) = 1 + exc(1,2) = tz+ishift + endif + if (hole /= 0_bit_kind) then + tz = trailz(hole) + exc(0,1) = 1 + exc(1,1) = tz+ishift + endif + + if ( iand(exc(0,1),exc(0,2)) /= 1) then ! exc(0,1)/=1 and exc(0,2) /= 1 + cycle + endif + + low = min(exc(1,1),exc(1,2)) + high = max(exc(1,1),exc(1,2)) + + ASSERT (low > 0) + j = ishft(low-1,-bit_kind_shift)+1 ! Find integer in array(Nint) + n = iand(low-1,bit_kind_size-1)+1 ! mod(low,bit_kind_size) + ASSERT (high > 0) + k = ishft(high-1,-bit_kind_shift)+1 + m = iand(high-1,bit_kind_size-1)+1 + if (j==k) then + nperm = popcnt(iand(det1(j), & + iand(ibset(0_bit_kind,m-1)-1_bit_kind,ibclr(-1_bit_kind,n)+1_bit_kind))) + else + nperm = nperm + popcnt(iand(det1(k),ibset(0_bit_kind,m-1)-1_bit_kind)) + if (n < bit_kind_size) then + nperm = nperm + popcnt(iand(det1(j),ibclr(-1_bit_kind,n)+1_bit_kind)) + endif + do i=j+1,k-1 + nperm = nperm + popcnt(det1(i)) + end do + endif + phase = phase_dble(iand(nperm,1)) + return + + enddo +end + +subroutine i_H_j_mono_spin(key_i,key_j,Nint,spin,hij) + use bitmasks + implicit none + BEGIN_DOC + ! Returns where i and j are determinants differing by a single excitation + END_DOC + integer, intent(in) :: Nint, spin + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij + + integer :: exc(0:2,2) + double precision :: phase + + PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + + call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint) + call get_mono_excitation_from_fock(key_i,key_j,exc(1,2),exc(1,1),spin,phase,hij) +end + +subroutine i_H_j_double_spin(key_i,key_j,Nint,hij) + use bitmasks + implicit none + BEGIN_DOC + ! Returns where i and j are determinants differing by a same-spin double excitation + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint), key_j(Nint) + double precision, intent(out) :: hij + + integer :: exc(0:2,2) + double precision :: phase + double precision, external :: get_mo_bielec_integral + + PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + + call get_double_excitation_spin(key_i,key_j,exc,phase,Nint) + hij = phase*(get_mo_bielec_integral( & + exc(1,1), & + exc(2,1), & + exc(1,2), & + exc(2,2), mo_integrals_map) - & + get_mo_bielec_integral( & + exc(1,1), & + exc(2,1), & + exc(2,2), & + exc(1,2), mo_integrals_map) ) +end + +subroutine i_H_j_double_alpha_beta(key_i,key_j,Nint,hij) + use bitmasks + implicit none + BEGIN_DOC + ! Returns where i and j are determinants differing by an opposite-spin double excitation + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: key_i(Nint,2), key_j(Nint,2) + double precision, intent(out) :: hij + + integer :: exc(0:2,2,2) + double precision :: phase + double precision, external :: get_mo_bielec_integral + + PROVIDE big_array_exchange_integrals mo_bielec_integrals_in_map + + call get_mono_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint) + call get_mono_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase,Nint) + if (exc(1,1,1) == exc(1,2,2)) then + hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1)) + else if (exc(1,2,1) == exc(1,1,2)) then + hij = phase * big_array_exchange_integrals(exc(1,2,1),exc(1,1,1),exc(1,2,2)) + else + hij = phase*get_mo_bielec_integral( & + exc(1,1,1), & + exc(1,1,2), & + exc(1,2,1), & + exc(1,2,2) ,mo_integrals_map) + endif +end + + diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index acc49d50..4bb35979 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/src/Determinants/spindeterminants.irp.f @@ -386,8 +386,9 @@ END_PROVIDER !==============================================================================! BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ] -&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_rows, (N_det) ] +&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_rows , (N_det) ] &BEGIN_PROVIDER [ integer, psi_bilinear_matrix_columns, (N_det) ] +&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order , (N_det) ] use bitmasks implicit none BEGIN_DOC @@ -395,19 +396,20 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) ! D_a^t C D_b ! ! Rows are alpha determinants and columns are beta. +! +! Order refers to psi_det END_DOC integer :: i,j,k, l integer(bit_kind) :: tmp_det(N_int,2) - integer :: idx integer, external :: get_index_in_psi_det_sorted_bit PROVIDE psi_coef_sorted_bit - integer, allocatable :: iorder(:), to_sort(:) + integer, allocatable :: to_sort(:) integer, external :: get_index_in_psi_det_alpha_unique integer, external :: get_index_in_psi_det_beta_unique - allocate(iorder(N_det), to_sort(N_det)) + allocate(to_sort(N_det)) do k=1,N_det i = get_index_in_psi_det_alpha_unique(psi_det(1,1,k),N_int) j = get_index_in_psi_det_beta_unique (psi_det(1,2,k),N_int) @@ -418,36 +420,41 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_values, (N_det,N_states) psi_bilinear_matrix_rows(k) = i psi_bilinear_matrix_columns(k) = j to_sort(k) = N_det_alpha_unique * (j-1) + i - iorder(k) = k + psi_bilinear_matrix_order(k) = k enddo - call isort(to_sort, iorder, N_det) - call iset_order(psi_bilinear_matrix_rows,iorder,N_det) - call iset_order(psi_bilinear_matrix_columns,iorder,N_det) + call isort(to_sort, psi_bilinear_matrix_order, N_det) + call iset_order(psi_bilinear_matrix_rows,psi_bilinear_matrix_order,N_det) + call iset_order(psi_bilinear_matrix_columns,psi_bilinear_matrix_order,N_det) do l=1,N_states - call dset_order(psi_bilinear_matrix_values(1,l),iorder,N_det) + call dset_order(psi_bilinear_matrix_values(1,l),psi_bilinear_matrix_order,N_det) enddo - deallocate(iorder,to_sort) + deallocate(to_sort) END_PROVIDER BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_states) ] -&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows, (N_det) ] +&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_rows , (N_det) ] &BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_columns, (N_det) ] +&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_transp_order , (N_det) ] +&BEGIN_PROVIDER [ integer, psi_bilinear_matrix_order_reverse , (N_det) ] use bitmasks implicit none BEGIN_DOC ! Sparse coefficient matrix if the wave function is expressed in a bilinear form : ! D_a^t C D_b ! -! Rows are Beta determinants and columns are alpha +! Rows are Alpha determinants and columns are beta, but the matrix is stored in row major +! format +! +! Order refers to psi_bilinear_matrix END_DOC integer :: i,j,k,l PROVIDE psi_coef_sorted_bit - integer, allocatable :: iorder(:), to_sort(:) - allocate(iorder(N_det), to_sort(N_det)) + integer, allocatable :: to_sort(:) + allocate(to_sort(N_det)) do l=1,N_states do k=1,N_det psi_bilinear_matrix_transp_values (k,l) = psi_bilinear_matrix_values (k,l) @@ -459,15 +466,18 @@ BEGIN_PROVIDER [ double precision, psi_bilinear_matrix_transp_values, (N_det,N_ i = psi_bilinear_matrix_transp_columns(k) j = psi_bilinear_matrix_transp_rows (k) to_sort(k) = N_det_beta_unique * (j-1) + i - iorder(k) = k + psi_bilinear_matrix_transp_order(k) = k enddo - call isort(to_sort, iorder, N_det) - call iset_order(psi_bilinear_matrix_transp_rows,iorder,N_det) - call iset_order(psi_bilinear_matrix_transp_columns,iorder,N_det) + call isort(to_sort, psi_bilinear_matrix_transp_order, N_det) + call iset_order(psi_bilinear_matrix_transp_rows,psi_bilinear_matrix_transp_order,N_det) + call iset_order(psi_bilinear_matrix_transp_columns,psi_bilinear_matrix_transp_order,N_det) do l=1,N_states - call dset_order(psi_bilinear_matrix_transp_values(1,l),iorder,N_det) + call dset_order(psi_bilinear_matrix_transp_values(1,l),psi_bilinear_matrix_transp_order,N_det) enddo - deallocate(iorder,to_sort) + do k=1,N_det + psi_bilinear_matrix_order_reverse(psi_bilinear_matrix_transp_order(k)) = k + enddo + deallocate(to_sort) END_PROVIDER @@ -552,7 +562,7 @@ subroutine generate_all_alpha_beta_det_products ! Create a wave function from all possible alpha x beta determinants END_DOC integer :: i,j,k,l - integer :: idx, iproc + integer :: iproc integer, external :: get_index_in_psi_det_sorted_bit integer(bit_kind), allocatable :: tmp_det(:,:,:) logical, external :: is_in_wavefunction @@ -561,7 +571,7 @@ subroutine generate_all_alpha_beta_det_products !$OMP PARALLEL DEFAULT(NONE) SHARED(psi_coef_sorted_bit,N_det_beta_unique,& !$OMP N_det_alpha_unique, N_int, psi_det_alpha_unique, psi_det_beta_unique,& !$OMP N_det) & - !$OMP PRIVATE(i,j,k,l,tmp_det,idx,iproc) + !$OMP PRIVATE(i,j,k,l,tmp_det,iproc) !$ iproc = omp_get_thread_num() allocate (tmp_det(N_int,2,N_det_alpha_unique)) !$OMP DO @@ -586,3 +596,782 @@ subroutine generate_all_alpha_beta_det_products end + + +subroutine get_all_spin_singles_and_doubles(buffer, idx, spindet, Nint, size_buffer, singles, doubles, n_singles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single and double excitations in the list of +! unique alpha determinants. +! +! /!\ : The buffer is transposed ! +! + END_DOC + integer, intent(in) :: Nint, size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(Nint,size_buffer) + integer(bit_kind), intent(in) :: spindet(Nint) + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_singles + integer, intent(out) :: n_doubles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + select case (Nint) + case (1) + call get_all_spin_singles_and_doubles_1(buffer, idx, spindet(1), size_buffer, singles, doubles, n_singles, n_doubles) + return +! case (2) +! call get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles) +! return + case (3) + call get_all_spin_singles_and_doubles_3(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles) + return + end select + + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, Nint), degree(size_buffer) ) + + do k=1,Nint + do i=1,size_buffer + xorvec(i, k) = xor( spindet(k), buffer(k,i) ) + enddo + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + do k=2,Nint + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,k) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,k)) + endif + enddo + enddo + + n_singles = 1 + n_doubles = 1 + do i=1,size_buffer + if ( degree(i) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + if ( degree(i) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_singles(buffer, idx, spindet, Nint, size_buffer, singles, n_singles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: Nint, size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(Nint,size_buffer) + integer(bit_kind), intent(in) :: spindet(Nint) + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: n_singles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + select case (Nint) + case (1) + call get_all_spin_singles_1(buffer, idx, spindet(1), size_buffer, singles, n_singles) + return + case (2) + call get_all_spin_singles_2(buffer, idx, spindet, size_buffer, singles, n_singles) + return + case (3) + call get_all_spin_singles_3(buffer, idx, spindet, size_buffer, singles, n_singles) + return + end select + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, Nint), degree(size_buffer) ) + + do k=1,Nint + do i=1,size_buffer + xorvec(i, k) = xor( spindet(k), buffer(k,i) ) + enddo + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + do k=2,Nint + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 2).and.(xorvec(i,k) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,k)) + endif + enddo + enddo + + n_singles = 1 + do i=1,size_buffer + if ( degree(i) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_doubles(buffer, idx, spindet, Nint, size_buffer, doubles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the double excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: Nint, size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(Nint,size_buffer) + integer(bit_kind), intent(in) :: spindet(Nint) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_doubles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + select case (Nint) + case (1) + call get_all_spin_doubles_1(buffer, idx, spindet(1), size_buffer, doubles, n_doubles) + return + case (2) + call get_all_spin_doubles_2(buffer, idx, spindet, size_buffer, doubles, n_doubles) + return + case (3) + call get_all_spin_doubles_3(buffer, idx, spindet, size_buffer, doubles, n_doubles) + return + end select + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, Nint), degree(size_buffer) ) + + do k=1,Nint + do i=1,size_buffer + xorvec(i, k) = xor( spindet(k), buffer(k,i) ) + enddo + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + do k=2,Nint + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,k) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,k)) + endif + enddo + enddo + + n_doubles = 1 + do i=1,size_buffer + if ( degree(i) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + enddo + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + +subroutine get_all_spin_singles_and_doubles_1(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single and double excitations in the list of +! unique alpha determinants. +! +! /!\ : The buffer is transposed ! +! + END_DOC + integer, intent(in) :: size_buffer + integer, intent(in) :: idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(size_buffer) + integer(bit_kind), intent(in) :: spindet + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_singles + integer, intent(out) :: n_doubles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:) + integer :: degree + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align) ) + + do i=1,size_buffer + xorvec(i) = xor( spindet, buffer(i) ) + enddo + + n_singles = 1 + n_doubles = 1 + + do i=1,size_buffer + degree = popcnt(xorvec(i)) + if ( degree == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + if ( degree == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + n_doubles = n_doubles-1 + + deallocate(xorvec) +end + + +subroutine get_all_spin_singles_1(buffer, idx, spindet, size_buffer, singles, n_singles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(size_buffer) + integer(bit_kind), intent(in) :: spindet + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: n_singles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:) + + allocate( xorvec(size_buffer) ) + + do i=1,size_buffer + xorvec(i) = xor( spindet, buffer(i) ) + enddo + + n_singles = 1 + do i=1,size_buffer + if ( popcnt(xorvec(i)) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_doubles_1(buffer, idx, spindet, size_buffer, doubles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the double excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(size_buffer) + integer(bit_kind), intent(in) :: spindet + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_doubles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:) + + integer, external :: align_double + + allocate( xorvec(size_buffer) ) + + do i=1,size_buffer + xorvec(i) = xor( spindet, buffer(i) ) + enddo + + n_doubles = 1 + + do i=1,size_buffer + if ( popcnt(xorvec(i)) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + enddo + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_singles_and_doubles_2(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single and double excitations in the list of +! unique alpha determinants. +! +! /!\ : The buffer is transposed ! +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(2,size_buffer) + integer(bit_kind), intent(in) :: spindet(2) + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_singles + integer, intent(out) :: n_doubles + + integer :: i + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, 2), degree(size_buffer) ) + + do i=1,size_buffer + xorvec(i, 1) = xor( spindet(1), buffer(1,i) ) + xorvec(i, 2) = xor( spindet(2), buffer(2,i) ) + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,2) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,2)) + endif + enddo + + n_singles = 1 + n_doubles = 1 + do i=1,size_buffer + if ( degree(i) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + if ( degree(i) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_singles_2(buffer, idx, spindet, size_buffer, singles, n_singles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(2,size_buffer) + integer(bit_kind), intent(in) :: spindet(2) + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: n_singles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, 2), degree(size_buffer) ) + + do i=1,size_buffer + xorvec(i, 1) = xor( spindet(1), buffer(1,i) ) + xorvec(i, 2) = xor( spindet(2), buffer(2,i) ) + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 2).and.(xorvec(i,2) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,2)) + endif + enddo + + n_singles = 1 + do i=1,size_buffer + if ( degree(i) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_doubles_2(buffer, idx, spindet, size_buffer, doubles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the double excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(2,size_buffer) + integer(bit_kind), intent(in) :: spindet(2) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_doubles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, 2), degree(size_buffer) ) + + do i=1,size_buffer + xorvec(i, 1) = xor( spindet(1), buffer(1,i) ) + xorvec(i, 2) = xor( spindet(2), buffer(2,i) ) + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,2) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,2)) + endif + enddo + + n_doubles = 1 + do i=1,size_buffer + if ( degree(i) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + enddo + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + +subroutine get_all_spin_singles_and_doubles_3(buffer, idx, spindet, size_buffer, singles, doubles, n_singles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single and double excitations in the list of +! unique alpha determinants. +! +! /!\ : The buffer is transposed ! +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(3,size_buffer) + integer(bit_kind), intent(in) :: spindet(3) + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_singles + integer, intent(out) :: n_doubles + + integer :: i + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, 3), degree(size_buffer) ) + + do i=1,size_buffer + xorvec(i, 1) = xor( spindet(1), buffer(1,i) ) + xorvec(i, 2) = xor( spindet(2), buffer(2,i) ) + xorvec(i, 3) = xor( spindet(3), buffer(3,i) ) + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,2) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,2)) + endif + enddo + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,3) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,3)) + endif + enddo + + n_singles = 1 + n_doubles = 1 + do i=1,size_buffer + if ( degree(i) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + if ( degree(i) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_singles_3(buffer, idx, spindet, size_buffer, singles, n_singles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the single excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(3,size_buffer) + integer(bit_kind), intent(in) :: spindet(3) + integer, intent(out) :: singles(size_buffer) + integer, intent(out) :: n_singles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, 3), degree(size_buffer) ) + + do i=1,size_buffer + xorvec(i, 1) = xor( spindet(1), buffer(1,i) ) + xorvec(i, 2) = xor( spindet(2), buffer(2,i) ) + xorvec(i, 3) = xor( spindet(3), buffer(3,i) ) + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 2).and.(xorvec(i,2) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,2)) + endif + enddo + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 2).and.(xorvec(i,3) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,3)) + endif + enddo + + n_singles = 1 + do i=1,size_buffer + if ( degree(i) == 2 ) then + singles(n_singles) = idx(i) + n_singles = n_singles+1 + endif + enddo + n_singles = n_singles-1 + deallocate(xorvec) + +end + + +subroutine get_all_spin_doubles_3(buffer, idx, spindet, size_buffer, doubles, n_doubles) + use bitmasks + implicit none + BEGIN_DOC +! +! Returns the indices of all the double excitations in the list of +! unique alpha determinants. +! + END_DOC + integer, intent(in) :: size_buffer, idx(size_buffer) + integer(bit_kind), intent(in) :: buffer(3,size_buffer) + integer(bit_kind), intent(in) :: spindet(3) + integer, intent(out) :: doubles(size_buffer) + integer, intent(out) :: n_doubles + + integer :: i,k + integer(bit_kind), allocatable :: xorvec(:,:) + integer, allocatable :: degree(:) + integer :: size_buffer_align + + integer, external :: align_double + + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: xorvec, degree + + size_buffer_align = align_double(size_buffer) + allocate( xorvec(size_buffer_align, 3), degree(size_buffer) ) + + do i=1,size_buffer + xorvec(i, 1) = xor( spindet(1), buffer(1,i) ) + xorvec(i, 2) = xor( spindet(2), buffer(2,i) ) + xorvec(i, 3) = xor( spindet(3), buffer(3,i) ) + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if (xorvec(i,1) /= 0_8) then + degree(i) = popcnt(xorvec(i,1)) + else + degree(i) = 0 + endif + enddo + + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,2) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,2)) + endif + enddo + !DIR$ VECTOR ALIGNED + do i=1,size_buffer + if ( (degree(i) <= 4).and.(xorvec(i,3) /= 0_8) ) then + degree(i) = degree(i) + popcnt(xorvec(i,3)) + endif + enddo + + n_doubles = 1 + do i=1,size_buffer + if ( degree(i) == 4 ) then + doubles(n_doubles) = idx(i) + n_doubles = n_doubles+1 + endif + enddo + n_doubles = n_doubles-1 + deallocate(xorvec) + +end + diff --git a/src/Determinants/usefull_for_ovb.irp.f b/src/Determinants/useful_for_ovb.irp.f similarity index 97% rename from src/Determinants/usefull_for_ovb.irp.f rename to src/Determinants/useful_for_ovb.irp.f index 7b89897b..25bdb03a 100644 --- a/src/Determinants/usefull_for_ovb.irp.f +++ b/src/Determinants/useful_for_ovb.irp.f @@ -2,7 +2,8 @@ integer function n_open_shell(det_in,nint) implicit none use bitmasks - integer(bit_kind), intent(in) :: det_in(nint,2),nint + integer, intent(in) :: nint + integer(bit_kind), intent(in) :: det_in(nint,2) integer :: i n_open_shell = 0 do i=1,Nint @@ -13,7 +14,8 @@ end integer function n_closed_shell(det_in,nint) implicit none use bitmasks - integer(bit_kind), intent(in) :: det_in(nint,2),nint + integer, intent(in) :: nint + integer(bit_kind), intent(in) :: det_in(nint,2) integer :: i n_closed_shell = 0 do i=1,Nint @@ -24,7 +26,8 @@ end integer function n_closed_shell_cas(det_in,nint) implicit none use bitmasks - integer(bit_kind), intent(in) :: det_in(nint,2),nint + integer, intent(in) :: nint + integer(bit_kind), intent(in) :: det_in(nint,2) integer(bit_kind) :: det_tmp(nint,2) integer :: i n_closed_shell_cas = 0 diff --git a/src/Integrals_Bielec/map_integrals.irp.f b/src/Integrals_Bielec/map_integrals.irp.f index 1f2a7a1b..82b89f22 100644 --- a/src/Integrals_Bielec/map_integrals.irp.f +++ b/src/Integrals_Bielec/map_integrals.irp.f @@ -44,8 +44,8 @@ subroutine bielec_integrals_index_reverse(i,j,k,l,i1) l(1) = ceiling(0.5d0*(dsqrt(8.d0*dble(i2)+1.d0)-1.d0)) i3 = i1 - ishft(i2*i2-i2,-1) k(1) = ceiling(0.5d0*(dsqrt(8.d0*dble(i3)+1.d0)-1.d0)) - j(1) = i2 - ishft(l(1)*l(1)-l(1),-1) - i(1) = i3 - ishft(k(1)*k(1)-k(1),-1) + j(1) = int(i2 - ishft(l(1)*l(1)-l(1),-1),4) + i(1) = int(i3 - ishft(k(1)*k(1)-k(1),-1),4) !ijkl i(2) = i(1) !ilkj diff --git a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f index 186938c2..bfe10b91 100644 --- a/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f +++ b/src/Integrals_Monoelec/pot_ao_pseudo_ints.irp.f @@ -51,7 +51,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu print*, 'Providing the nuclear electron pseudo integrals (local)' call wall_time(wall_1) - wall_0 = wall_1 call cpu_time(cpu_1) thread_num = 0 @@ -66,6 +65,8 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu !$OMP wall_1) !$ thread_num = omp_get_thread_num() + + wall_0 = wall_1 !$OMP DO SCHEDULE (guided) do j = 1, ao_num @@ -148,7 +149,6 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu print*, 'Providing the nuclear electron pseudo integrals (non-local)' call wall_time(wall_1) - wall_0 = wall_1 call cpu_time(cpu_1) thread_num = 0 @@ -164,6 +164,7 @@ BEGIN_PROVIDER [ double precision, ao_pseudo_integral_local, (ao_num_align,ao_nu !$ thread_num = omp_get_thread_num() + wall_0 = wall_1 !$OMP DO SCHEDULE (guided) ! do j = 1, ao_num diff --git a/src/MO_Basis/ao_ortho_canonical.irp.f b/src/MO_Basis/ao_ortho_canonical.irp.f index 95a771b0..48341129 100644 --- a/src/MO_Basis/ao_ortho_canonical.irp.f +++ b/src/MO_Basis/ao_ortho_canonical.irp.f @@ -42,7 +42,7 @@ 9;; END_TEMPLATE case default - stop 'Error in ao_cart_to_sphe' + stop 'Error in ao_cart_to_sphe : angular momentum too high' end select enddo diff --git a/src/MO_Basis/cholesky_mo.irp.f b/src/MO_Basis/cholesky_mo.irp.f index 65184c1e..774198a3 100644 --- a/src/MO_Basis/cholesky_mo.irp.f +++ b/src/MO_Basis/cholesky_mo.irp.f @@ -50,12 +50,88 @@ subroutine cholesky_mo(n,m,P,LDP,C,LDC,tol_in,rank) deallocate(W,work) end +!subroutine svd_mo(n,m,P,LDP,C,LDC) +!implicit none +!BEGIN_DOC +! Singular value decomposition of the AO Density matrix +! +! n : Number of AOs + +! m : Number of MOs +! +! P(LDP,n) : Density matrix in AO basis +! +! C(LDC,m) : MOs +! +! tol_in : tolerance +! +! rank : Nomber of local MOs (output) +! +!END_DOC +!integer, intent(in) :: n,m, LDC, LDP +!double precision, intent(in) :: P(LDP,n) +!double precision, intent(out) :: C(LDC,m) + +!integer :: info +!integer :: i,k +!integer :: ipiv(n) +!double precision:: tol +!double precision, allocatable :: W(:,:), work(:) + +!allocate(W(LDC,n),work(2*n)) +!call svd(P,LDP,C,LDC,W,size(W,1),m,n) + +!deallocate(W,work) +!end + subroutine svd_mo(n,m,P,LDP,C,LDC) implicit none BEGIN_DOC ! Singular value decomposition of the AO Density matrix ! ! n : Number of AOs +! +! m : Number of MOs +! +! P(LDP,n) : Density matrix in AO basis +! +! C(LDC,m) : MOs +! + END_DOC + integer, intent(in) :: n,m, LDC, LDP + double precision, intent(in) :: P(LDP,n) + double precision, intent(out) :: C(LDC,m) + + integer :: info + integer :: i,k + integer :: ipiv(n) + double precision:: tol + double precision, allocatable :: W(:,:), work(:), D(:) + + allocate(W(LDC,n),work(2*n),D(n)) + print*, '' + do i = 1, n + print*, P(i,i) + enddo + call svd(P,LDP,C,LDC,D,W,size(W,1),m,n) + double precision :: accu + accu = 0.d0 + print*, 'm',m + do i = 1, m + print*, D(i) + accu += D(i) + enddo + print*,'Sum of D',accu + + deallocate(W,work) +end + +subroutine svd_mo_new(n,m,m_physical,P,LDP,C,LDC) + implicit none + BEGIN_DOC +! Singular value decomposition of the AO Density matrix +! +! n : Number of AOs ! m : Number of MOs ! @@ -68,7 +144,7 @@ subroutine svd_mo(n,m,P,LDP,C,LDC) ! rank : Nomber of local MOs (output) ! END_DOC - integer, intent(in) :: n,m, LDC, LDP + integer, intent(in) :: n,m,m_physical, LDC, LDP double precision, intent(in) :: P(LDP,n) double precision, intent(out) :: C(LDC,m) @@ -76,10 +152,18 @@ subroutine svd_mo(n,m,P,LDP,C,LDC) integer :: i,k integer :: ipiv(n) double precision:: tol - double precision, allocatable :: W(:,:), work(:) + double precision, allocatable :: W(:,:), work(:), D(:) - allocate(W(LDC,n),work(2*n)) - call svd(P,LDP,C,LDC,W,size(W,1),m,n) + allocate(W(LDC,n),work(2*n),D(n)) + call svd(P,LDP,C,LDC,D,W,size(W,1),m_physical,n) + double precision :: accu + accu = 0.d0 + print*, 'm',m_physical + do i = 1, m_physical + print*, D(i) + accu += D(i) + enddo + print*,'Sum of D',accu deallocate(W,work) end diff --git a/src/MO_Basis/mos.irp.f b/src/MO_Basis/mos.irp.f index 19835395..56ab8d2f 100644 --- a/src/MO_Basis/mos.irp.f +++ b/src/MO_Basis/mos.irp.f @@ -181,24 +181,146 @@ subroutine mo_to_ao(A_mo,LDA_mo,A_ao,LDA_ao) allocate ( T(mo_tot_num_align,ao_num) ) !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T +! SC call dgemm('N','N', ao_num, mo_tot_num, ao_num, & 1.d0, ao_overlap,size(ao_overlap,1), & mo_coef, size(mo_coef,1), & 0.d0, SC, ao_num_align) +! A.CS call dgemm('N','T', mo_tot_num, ao_num, mo_tot_num, & 1.d0, A_mo,LDA_mo, & SC, size(SC,1), & 0.d0, T, mo_tot_num_align) +! SC.A.CS call dgemm('N','N', ao_num, ao_num, mo_tot_num, & 1.d0, SC,size(SC,1), & T, mo_tot_num_align, & 0.d0, A_ao, LDA_ao) +! C(S.A.S)C +! SC.A.CS deallocate(T,SC) end + +subroutine mo_to_ao_s_inv_1_2(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the AO basis using the S^{-1} matrix + ! S^{-1} C A C^{+} S^{-1} + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + double precision, intent(in) :: A_mo(LDA_mo) + double precision, intent(out) :: A_ao(LDA_ao) + double precision, allocatable :: T(:,:), SC_inv_1_2(:,:) + + allocate ( SC_inv_1_2(ao_num_align,mo_tot_num) ) + allocate ( T(mo_tot_num_align,ao_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + +! SC_inv_1_2 = S^{-1}C + call dgemm('N','N', ao_num, mo_tot_num, ao_num, & + 1.d0, ao_overlap_inv_1_2,size(ao_overlap_inv_1_2,1), & + mo_coef, size(mo_coef,1), & + 0.d0, SC_inv_1_2, ao_num_align) + +! T = A.(SC_inv_1_2)^{+} + call dgemm('N','T', mo_tot_num, ao_num, mo_tot_num, & + 1.d0, A_mo,LDA_mo, & + SC_inv_1_2, size(SC_inv_1_2,1), & + 0.d0, T, mo_tot_num_align) + +! SC_inv_1_2.A.CS + call dgemm('N','N', ao_num, ao_num, mo_tot_num, & + 1.d0, SC_inv_1_2,size(SC_inv_1_2,1), & + T, mo_tot_num_align, & + 0.d0, A_ao, LDA_ao) + +! C(S.A.S)C +! SC_inv_1_2.A.CS + deallocate(T,SC_inv_1_2) +end + +subroutine mo_to_ao_s_1_2(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the AO basis using the S^{-1} matrix + ! S^{-1} C A C^{+} S^{-1} + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + double precision, intent(in) :: A_mo(LDA_mo) + double precision, intent(out) :: A_ao(LDA_ao) + double precision, allocatable :: T(:,:), SC_1_2(:,:) + + allocate ( SC_1_2(ao_num_align,mo_tot_num) ) + allocate ( T(mo_tot_num_align,ao_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + +! SC_1_2 = S^{-1}C + call dgemm('N','N', ao_num, mo_tot_num, ao_num, & + 1.d0, ao_overlap_1_2,size(ao_overlap_1_2,1), & + mo_coef, size(mo_coef,1), & + 0.d0, SC_1_2, ao_num_align) + +! T = A.(SC_1_2)^{+} + call dgemm('N','T', mo_tot_num, ao_num, mo_tot_num, & + 1.d0, A_mo,LDA_mo, & + SC_1_2, size(SC_1_2,1), & + 0.d0, T, mo_tot_num_align) + +! SC_1_2.A.CS + call dgemm('N','N', ao_num, ao_num, mo_tot_num, & + 1.d0, SC_1_2,size(SC_1_2,1), & + T, mo_tot_num_align, & + 0.d0, A_ao, LDA_ao) + +! C(S.A.S)C +! SC_1_2.A.CS + deallocate(T,SC_1_2) +end + + +subroutine mo_to_ao_s_inv(A_mo,LDA_mo,A_ao,LDA_ao) + implicit none + BEGIN_DOC + ! Transform A from the MO basis to the AO basis using the S^{-1} matrix + ! S^{-1} C A C^{+} S^{-1} + END_DOC + integer, intent(in) :: LDA_ao,LDA_mo + double precision, intent(in) :: A_mo(LDA_mo) + double precision, intent(out) :: A_ao(LDA_ao) + double precision, allocatable :: T(:,:), SC_inv(:,:) + + allocate ( SC_inv(ao_num_align,mo_tot_num) ) + allocate ( T(mo_tot_num_align,ao_num) ) + !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T + +! SC_inv = S^{-1}C + call dgemm('N','N', ao_num, mo_tot_num, ao_num, & + 1.d0, ao_overlap_inv,size(ao_overlap_inv,1), & + mo_coef, size(mo_coef,1), & + 0.d0, SC_inv, ao_num_align) + +! T = A.(SC_inv)^{+} + call dgemm('N','T', mo_tot_num, ao_num, mo_tot_num, & + 1.d0, A_mo,LDA_mo, & + SC_inv, size(SC_inv,1), & + 0.d0, T, mo_tot_num_align) + +! SC_inv.A.CS + call dgemm('N','N', ao_num, ao_num, mo_tot_num, & + 1.d0, SC_inv,size(SC_inv,1), & + T, mo_tot_num_align, & + 0.d0, A_ao, LDA_ao) + +! C(S.A.S)C +! SC_inv.A.CS + deallocate(T,SC_inv) +end + + subroutine mo_to_ao_no_overlap(A_mo,LDA_mo,A_ao,LDA_ao) implicit none BEGIN_DOC diff --git a/src/MO_Basis/utils.irp.f b/src/MO_Basis/utils.irp.f index 0f338877..8afa8744 100644 --- a/src/MO_Basis/utils.irp.f +++ b/src/MO_Basis/utils.irp.f @@ -88,7 +88,7 @@ subroutine mo_as_eigvectors_of_mo_matrix(matrix,n,m,label,sign) enddo endif do i=1,m - write (output_mo_basis,'(I8,X,F16.10)') i,eigvalues(i) + write (output_mo_basis,'(I8,1X,F16.10)') i,eigvalues(i) enddo write (output_mo_basis,'(A)') '======== ================' write (output_mo_basis,'(A)') '' @@ -135,7 +135,7 @@ subroutine mo_as_svd_vectors_of_mo_matrix(matrix,lda,m,n,label) write (output_mo_basis,'(A)') '======== ================' do i=1,m - write (output_mo_basis,'(I8,X,F16.10)') i,D(i) + write (output_mo_basis,'(I8,1X,F16.10)') i,D(i) enddo write (output_mo_basis,'(A)') '======== ================' write (output_mo_basis,'(A)') '' @@ -215,7 +215,7 @@ subroutine mo_as_eigvectors_of_mo_matrix_sort_by_observable(matrix,observable,n, write (output_mo_basis,'(A)') '' write (output_mo_basis,'(A)') '======== ================' do i = 1, m - write (output_mo_basis,'(I8,X,F16.10)') i,eigvalues(i) + write (output_mo_basis,'(I8,1X,F16.10)') i,eigvalues(i) enddo write (output_mo_basis,'(A)') '======== ================' write (output_mo_basis,'(A)') '' @@ -272,21 +272,13 @@ subroutine give_all_mos_at_r(r,mos_array) implicit none double precision, intent(in) :: r(3) double precision, intent(out) :: mos_array(mo_tot_num) - call give_specific_mos_at_r(r,mos_array, mo_coef) -end - -subroutine give_specific_mos_at_r(r,mos_array, mo_coef_specific) - implicit none - double precision, intent(in) :: r(3) - double precision, intent(in) :: mo_coef_specific(ao_num_align, mo_tot_num) - double precision, intent(out) :: mos_array(mo_tot_num) double precision :: aos_array(ao_num),accu integer :: i,j call give_all_aos_at_r(r,aos_array) do i = 1, mo_tot_num accu = 0.d0 do j = 1, ao_num - accu += mo_coef_specific(j,i) * aos_array(j) + accu += mo_coef(j,i) * aos_array(j) enddo mos_array(i) = accu enddo diff --git a/src/Nuclei/nuclei.irp.f b/src/Nuclei/nuclei.irp.f index b4da5fb1..34fae989 100644 --- a/src/Nuclei/nuclei.irp.f +++ b/src/Nuclei/nuclei.irp.f @@ -37,8 +37,8 @@ BEGIN_PROVIDER [ double precision, nucl_coord, (nucl_num_aligned,3) ] enddo deallocate(buffer) - character*(64), parameter :: f = '(A16, 4(X,F12.6))' - character*(64), parameter :: ft= '(A16, 4(X,A12 ))' + character*(64), parameter :: f = '(A16, 4(1X,F12.6))' + character*(64), parameter :: ft= '(A16, 4(1X,A12 ))' double precision, parameter :: a0= 0.529177249d0 call write_time(output_Nuclei) write(output_Nuclei,'(A)') '' diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f index 2c318688..32090f01 100644 --- a/src/Utils/LinearAlgebra.irp.f +++ b/src/Utils/LinearAlgebra.irp.f @@ -19,6 +19,10 @@ subroutine svd(A,LDA,U,LDU,D,Vt,LDVt,m,n) double precision,allocatable :: A_tmp(:,:) allocate (A_tmp(LDA,n)) + print*, '' + do i = 1, n + print*, A(i,i) + enddo A_tmp = A ! Find optimal size for temp arrays @@ -26,7 +30,7 @@ subroutine svd(A,LDA,U,LDU,D,Vt,LDVt,m,n) lwork = -1 call dgesvd('A','A', m, n, A_tmp, LDA, & D, U, LDU, Vt, LDVt, work, lwork, info) - lwork = work(1) + lwork = int(work(1)) deallocate(work) allocate(work(lwork)) @@ -149,7 +153,7 @@ subroutine ortho_qr(A,LDA,m,n) allocate (jpvt(n), tau(n), work(1)) LWORK=-1 call dgeqrf( m, n, A, LDA, TAU, WORK, LWORK, INFO ) - LWORK=2*WORK(1) + LWORK=2*int(WORK(1)) deallocate(WORK) allocate(WORK(LWORK)) call dgeqrf(m, n, A, LDA, TAU, WORK, LWORK, INFO ) @@ -293,7 +297,7 @@ subroutine get_pseudo_inverse(A,m,n,C,LDA) print *, info, ': SVD failed' stop endif - lwork = work(1) + lwork = int(work(1)) deallocate(work) allocate(work(lwork)) call dgesvd('S','A', m, n, A_tmp, m,D,U,m,Vt,n,work,lwork,info) diff --git a/src/Utils/angular_integration.irp.f b/src/Utils/angular_integration.irp.f index 1efd4abc..757508a1 100644 --- a/src/Utils/angular_integration.irp.f +++ b/src/Utils/angular_integration.irp.f @@ -4,7 +4,7 @@ BEGIN_PROVIDER [integer, degree_max_integration_lebedev] ! needed for the angular integration according to LEBEDEV formulae END_DOC implicit none - degree_max_integration_lebedev= 15 + degree_max_integration_lebedev= 13 END_PROVIDER @@ -644,14 +644,14 @@ END_PROVIDER weights_angular_integration_lebedev(16) = 0.016604069565742d0 weights_angular_integration_lebedev(17) = 0.016604069565742d0 weights_angular_integration_lebedev(18) = 0.016604069565742d0 - weights_angular_integration_lebedev(19) = -0.029586038961039d0 - weights_angular_integration_lebedev(20) = -0.029586038961039d0 - weights_angular_integration_lebedev(21) = -0.029586038961039d0 - weights_angular_integration_lebedev(22) = -0.029586038961039d0 - weights_angular_integration_lebedev(23) = -0.029586038961039d0 - weights_angular_integration_lebedev(24) = -0.029586038961039d0 - weights_angular_integration_lebedev(25) = -0.029586038961039d0 - weights_angular_integration_lebedev(26) = -0.029586038961039d0 + weights_angular_integration_lebedev(19) = 0.029586038961039d0 + weights_angular_integration_lebedev(20) = 0.029586038961039d0 + weights_angular_integration_lebedev(21) = 0.029586038961039d0 + weights_angular_integration_lebedev(22) = 0.029586038961039d0 + weights_angular_integration_lebedev(23) = 0.029586038961039d0 + weights_angular_integration_lebedev(24) = 0.029586038961039d0 + weights_angular_integration_lebedev(25) = 0.029586038961039d0 + weights_angular_integration_lebedev(26) = 0.029586038961039d0 weights_angular_integration_lebedev(27) = 0.026576207082159d0 weights_angular_integration_lebedev(28) = 0.026576207082159d0 weights_angular_integration_lebedev(29) = 0.026576207082159d0 diff --git a/src/Utils/constants.include.F b/src/Utils/constants.include.F index 991ef80a..c077eb53 100644 --- a/src/Utils/constants.include.F +++ b/src/Utils/constants.include.F @@ -1,5 +1,6 @@ integer, parameter :: max_dim = 511 integer, parameter :: SIMD_vector = 32 +integer, parameter :: N_int_max = 16 double precision, parameter :: pi = dacos(-1.d0) double precision, parameter :: sqpi = dsqrt(dacos(-1.d0)) @@ -9,3 +10,7 @@ double precision, parameter :: dtwo_pi = 2.d0*dacos(-1.d0) double precision, parameter :: inv_sq_pi = 1.d0/dsqrt(dacos(-1.d0)) double precision, parameter :: inv_sq_pi_2 = 0.5d0/dsqrt(dacos(-1.d0)) double precision, parameter :: thresh = 1.d-15 +double precision, parameter :: cx_lda = -0.73855876638202234d0 +double precision, parameter :: c_2_4_3 = 2.5198420997897464d0 +double precision, parameter :: cst_lda = -0.93052573634909996d0 +double precision, parameter :: c_4_3 = 1.3333333333333333d0 diff --git a/src/Utils/invert.irp.f b/src/Utils/invert.irp.f new file mode 100644 index 00000000..4c626cca --- /dev/null +++ b/src/Utils/invert.irp.f @@ -0,0 +1,19 @@ +subroutine invert_matrix(A,LDA,na,A_inv,LDA_inv) +implicit none +double precision, intent(in) :: A (LDA,na) +integer, intent(in) :: LDA, LDA_inv +integer, intent(in) :: na +double precision, intent(out) :: A_inv (LDA_inv,na) + + double precision :: work(LDA_inv*max(na,64)) +!DIR$ ATTRIBUTES ALIGN: $IRP_ALIGN :: work + integer :: inf + integer :: ipiv(LDA_inv) +!DIR$ ATTRIBUTES ALIGN: $IRP_ALIGN :: ipiv + integer :: lwork + A_inv(1:na,1:na) = A(1:na,1:na) + call dgetrf(na, na, A_inv, LDA_inv, ipiv, inf ) + lwork = SIZE(work) + call dgetri(na, A_inv, LDA_inv, ipiv, work, lwork, inf ) +end + diff --git a/src/Utils/map_functions.irp.f b/src/Utils/map_functions.irp.f index f5d6f4f8..0378c253 100644 --- a/src/Utils/map_functions.irp.f +++ b/src/Utils/map_functions.irp.f @@ -76,8 +76,8 @@ subroutine map_load_from_disk(filename,map) double precision :: x type(c_ptr) :: c_pointer(3) integer :: fd(3) - integer*8 :: i,k, l - integer :: n_elements, j + integer*8 :: i,k,l + integer*4 :: j,n_elements @@ -105,14 +105,14 @@ subroutine map_load_from_disk(filename,map) map % map(i) % value => map % consolidated_value ( map % consolidated_idx (i+1) :) map % map(i) % key => map % consolidated_key ( map % consolidated_idx (i+1) :) map % map(i) % sorted = .True. - n_elements = map % consolidated_idx (i+2) - k + n_elements = int( map % consolidated_idx (i+2) - k, 4) k = map % consolidated_idx (i+2) map % map(i) % map_size = n_elements map % map(i) % n_elements = n_elements ! Load memory from disk do j=1,n_elements x = x + map % map(i) % value(j) - l = iand(l,map % map(i) % key(j)) + l = iand(l,int(map % map(i) % key(j),8)) if (map % map(i) % value(j) > 1.e30) then stop 'Error in integrals file' endif diff --git a/src/Utils/map_module.f90 b/src/Utils/map_module.f90 index 80260233..ac16f97e 100644 --- a/src/Utils/map_module.f90 +++ b/src/Utils/map_module.f90 @@ -53,17 +53,17 @@ module map_module end module map_module -real function map_mb(map) +double precision function map_mb(map) use map_module use omp_lib implicit none type (map_type), intent(in) :: map integer(map_size_kind) :: i - map_mb = 8+map_size_kind+map_size_kind+omp_lock_kind+4 + map_mb = dble(8+map_size_kind+map_size_kind+omp_lock_kind+4) do i=0,map%map_size - map_mb = map_mb + map%map(i)%map_size*(cache_key_kind+integral_kind) +& - 8+8+4+cache_map_size_kind+cache_map_size_kind+omp_lock_kind + map_mb = map_mb + dble(map%map(i)%map_size*(cache_key_kind+integral_kind) +& + 8+8+4+cache_map_size_kind+cache_map_size_kind+omp_lock_kind) enddo map_mb = map_mb / (1024.d0*1024.d0) end @@ -406,8 +406,8 @@ subroutine map_update(map, key, value, sze, thr) call cache_map_reallocate(local_map, local_map%n_elements + local_map%n_elements) call cache_map_shrink(local_map,thr) endif - cache_key = iand(key(i),map_mask) - local_map%n_elements = local_map%n_elements + 1_8 + cache_key = int(iand(key(i),map_mask),2) + local_map%n_elements = local_map%n_elements + 1 local_map%value(local_map%n_elements) = value(i) local_map%key(local_map%n_elements) = cache_key local_map%sorted = .False. @@ -464,7 +464,7 @@ subroutine map_append(map, key, value, sze) if (n_elements == map%map(idx_cache)%map_size) then call cache_map_reallocate(map%map(idx_cache), n_elements+ ishft(n_elements,-1)) endif - cache_key = iand(key(i),map_mask) + cache_key = int(iand(key(i),map_mask),2) map%map(idx_cache)%value(n_elements) = value(i) map%map(idx_cache)%key(n_elements) = cache_key map%map(idx_cache)%n_elements = n_elements @@ -615,7 +615,7 @@ subroutine search_key_big_interval(key,X,sze,idx,ibegin_in,iend_in) idx = -1 return endif - cache_key = iand(key,map_mask) + cache_key = int(iand(key,map_mask),2) ibegin = min(ibegin_in,sze) iend = min(iend_in,sze) if ((cache_key > X(ibegin)) .and. (cache_key < X(iend))) then @@ -723,7 +723,7 @@ subroutine search_key_value_big_interval(key,value,X,Y,sze,idx,ibegin_in,iend_in value = 0.d0 return endif - cache_key = iand(key,map_mask) + cache_key = int(iand(key,map_mask),2) ibegin = min(ibegin_in,sze) iend = min(iend_in,sze) if ((cache_key > X(ibegin)) .and. (cache_key < X(iend))) then diff --git a/src/Utils/sort.irp.f b/src/Utils/sort.irp.f index dd7fbc33..dc91ab3a 100644 --- a/src/Utils/sort.irp.f +++ b/src/Utils/sort.irp.f @@ -292,18 +292,17 @@ BEGIN_TEMPLATE ! contains the new order of the elements. ! iradix should be -1 in input. END_DOC - $int_type, intent(in) :: isize - $int_type, intent(inout) :: iorder(isize) - $type, intent(inout) :: x(isize) + integer*$int_type, intent(in) :: isize + integer*$int_type, intent(inout) :: iorder(isize) + integer*$type, intent(inout) :: x(isize) integer, intent(in) :: iradix integer :: iradix_new - $type, allocatable :: x2(:), x1(:) - $type :: i4 - $int_type, allocatable :: iorder1(:),iorder2(:) - $int_type :: i0, i1, i2, i3, i + integer*$type, allocatable :: x2(:), x1(:) + integer*$type :: i4 + integer*$int_type, allocatable :: iorder1(:),iorder2(:) + integer*$int_type :: i0, i1, i2, i3, i integer, parameter :: integer_size=$octets - $type, parameter :: zero=$zero - $type :: mask + integer*$type :: mask integer :: nthreads, omp_get_num_threads !DIR$ ATTRIBUTES ALIGN : 128 :: iorder1,iorder2, x2, x1 @@ -311,16 +310,16 @@ BEGIN_TEMPLATE ! Find most significant bit - i0 = 0_8 - i4 = -1_8 + i0 = 0_$int_type + i4 = -1_$type do i=1,isize i4 = max(i4,x(i)) enddo - i3 = i4 ! Type conversion + i3 = int(i4,$int_type) iradix_new = integer_size-1-leadz(i3) - mask = ibset(zero,iradix_new) + mask = ibset(0_$type,iradix_new) nthreads = 1 ! nthreads = 1+ishft(omp_get_num_threads(),-1) @@ -331,22 +330,22 @@ BEGIN_TEMPLATE stop endif - i1=1_8 - i2=1_8 + i1=1_$int_type + i2=1_$int_type do i=1,isize - if (iand(mask,x(i)) == zero) then + if (iand(mask,x(i)) == 0_$type) then iorder1(i1) = iorder(i) x1(i1) = x(i) - i1 = i1+1_8 + i1 = i1+1_$int_type else iorder2(i2) = iorder(i) x2(i2) = x(i) - i2 = i2+1_8 + i2 = i2+1_$int_type endif enddo - i1=i1-1_8 - i2=i2-1_8 + i1=i1-1_$int_type + i2=i2-1_$int_type do i=1,i1 iorder(i0+i) = iorder1(i) @@ -399,12 +398,12 @@ BEGIN_TEMPLATE endif - mask = ibset(zero,iradix) + mask = ibset(0_$type,iradix) i0=1 i1=1 do i=1,isize - if (iand(mask,x(i)) == zero) then + if (iand(mask,x(i)) == 0_$type) then iorder(i0) = iorder(i) x(i0) = x(i) i0 = i0+1 @@ -443,12 +442,12 @@ BEGIN_TEMPLATE end -SUBST [ X, type, octets, is_big, big, int_type, zero ] - i ; integer ; 32 ; .False. ; ; integer ; 0;; - i8 ; integer*8 ; 32 ; .False. ; ; integer ; 0_8;; - i2 ; integer*2 ; 32 ; .False. ; ; integer ; 0;; - i ; integer ; 64 ; .True. ; _big ; integer*8 ; 0 ;; - i8 ; integer*8 ; 64 ; .True. ; _big ; integer*8 ; 0_8 ;; +SUBST [ X, type, octets, is_big, big, int_type ] + i ; 4 ; 32 ; .False. ; ; 4 ;; + i8 ; 8 ; 32 ; .False. ; ; 4 ;; + i2 ; 2 ; 32 ; .False. ; ; 4 ;; + i ; 4 ; 64 ; .True. ; _big ; 8 ;; + i8 ; 8 ; 64 ; .True. ; _big ; 8 ;; END_TEMPLATE diff --git a/src/ZMQ/utils.irp.f b/src/ZMQ/utils.irp.f index 8e3a94e5..91ed9200 100644 --- a/src/ZMQ/utils.irp.f +++ b/src/ZMQ/utils.irp.f @@ -1,11 +1,8 @@ use f77_zmq use omp_lib -integer, pointer :: thread_id -integer(omp_lock_kind) :: zmq_lock - - -BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_context ] + BEGIN_PROVIDER [ integer(ZMQ_PTR), zmq_context ] +&BEGIN_PROVIDER [ integer(omp_lock_kind), zmq_lock ] use f77_zmq implicit none BEGIN_DOC @@ -407,7 +404,9 @@ subroutine end_zmq_sub_socket(zmq_socket_sub) integer(ZMQ_PTR), intent(in) :: zmq_socket_sub integer :: rc + call omp_set_lock(zmq_lock) rc = f77_zmq_close(zmq_socket_sub) + call omp_unset_lock(zmq_lock) if (rc /= 0) then print *, 'f77_zmq_close(zmq_socket_sub)' stop 'error' @@ -426,7 +425,9 @@ subroutine end_zmq_pair_socket(zmq_socket_pair) integer :: rc character*(8), external :: zmq_port + call omp_set_lock(zmq_lock) rc = f77_zmq_close(zmq_socket_pair) + call omp_unset_lock(zmq_lock) if (rc /= 0) then print *, 'f77_zmq_close(zmq_socket_pair)' stop 'error' @@ -444,7 +445,9 @@ subroutine end_zmq_pull_socket(zmq_socket_pull) integer :: rc character*(8), external :: zmq_port + call omp_set_lock(zmq_lock) rc = f77_zmq_close(zmq_socket_pull) + call omp_unset_lock(zmq_lock) if (rc /= 0) then print *, 'f77_zmq_close(zmq_socket_pull)' stop 'error' @@ -469,7 +472,9 @@ subroutine end_zmq_push_socket(zmq_socket_push,thread) stop 'Unable to set ZMQ_LINGER on push socket' endif + call omp_set_lock(zmq_lock) rc = f77_zmq_close(zmq_socket_push) + call omp_unset_lock(zmq_lock) if (rc /= 0) then print *, 'f77_zmq_close(zmq_socket_push)' stop 'error' @@ -500,10 +505,17 @@ subroutine new_parallel_job(zmq_to_qp_run_socket,name_in) integer(ZMQ_PTR),external :: new_zmq_to_qp_run_socket integer(ZMQ_PTR), intent(out) :: zmq_to_qp_run_socket + call omp_set_lock(zmq_lock) zmq_context = f77_zmq_ctx_new () + call omp_unset_lock(zmq_lock) if (zmq_context == 0_ZMQ_PTR) then stop 'ZMQ_PTR is null' endif +! rc = f77_zmq_ctx_set(zmq_context, ZMQ_IO_THREADS, nproc) +! if (rc /= 0) then +! print *, 'Unable to set the number of ZMQ IO threads to', nproc +! endif + zmq_to_qp_run_socket = new_zmq_to_qp_run_socket() name = name_in sze = len(trim(name)) @@ -584,7 +596,10 @@ subroutine end_parallel_job(zmq_to_qp_run_socket,name_in) zmq_state = 'No_state' call end_zmq_to_qp_run_socket(zmq_to_qp_run_socket) + call omp_set_lock(zmq_lock) rc = f77_zmq_ctx_term(zmq_context) + zmq_context = 0_ZMQ_PTR + call omp_unset_lock(zmq_lock) if (rc /= 0) then print *, 'Unable to terminate ZMQ context' stop 'error' diff --git a/tests/bats/cassd.bats b/tests/bats/cassd.bats index 1b845e91..67c35235 100644 --- a/tests/bats/cassd.bats +++ b/tests/bats/cassd.bats @@ -13,7 +13,7 @@ source $QP_ROOT/tests/bats/common.bats.sh qp_set_mo_class $INPUT -core "[1]" -inact "[2,5]" -act "[3,4,6,7]" -virt "[8-24]" qp_run cassd_zmq $INPUT energy="$(ezfio get cas_sd_zmq energy_pt2)" - eq $energy -76.231084536315 5.E-5 + eq $energy -76.231248286858 5.E-5 ezfio set determinants n_det_max 1024 ezfio set determinants read_wf True @@ -21,6 +21,6 @@ source $QP_ROOT/tests/bats/common.bats.sh qp_run cassd_zmq $INPUT ezfio set determinants read_wf False energy="$(ezfio get cas_sd_zmq energy)" - eq $energy -76.2225863580749 2.E-5 + eq $energy -76.2225678834779 2.E-5 } diff --git a/tests/bats/fci.bats b/tests/bats/fci.bats index 79ff91ab..6cded581 100644 --- a/tests/bats/fci.bats +++ b/tests/bats/fci.bats @@ -42,11 +42,13 @@ function run_FCI_ZMQ() { qp_set_mo_class h2o.ezfio -core "[1]" -act "[2-12]" -del "[13-24]" } @test "FCI H2O cc-pVDZ" { - run_FCI h2o.ezfio 2000 -0.761255633582109E+02 -0.761258377850042E+02 + run_FCI h2o.ezfio 2000 -76.1253758241716 -76.1258130146102 } + + @test "FCI-ZMQ H2O cc-pVDZ" { - run_FCI_ZMQ h2o.ezfio 2000 -0.761255633582109E+02 -0.761258377850042E+02 + run_FCI_ZMQ h2o.ezfio 2000 -76.1250552686394 -76.1258817228809 } diff --git a/tests/bats/mrcepa0.bats b/tests/bats/mrcepa0.bats index 2420955c..9a62885e 100644 --- a/tests/bats/mrcepa0.bats +++ b/tests/bats/mrcepa0.bats @@ -32,7 +32,7 @@ source $QP_ROOT/tests/bats/common.bats.sh ezfio set mrcepa0 n_it_max_dressed_ci 3 qp_run $EXE $INPUT energy="$(ezfio get mrcepa0 energy_pt2)" - eq $energy -76.2381673136696 2.e-4 + eq $energy -76.2381754078899 1.e-4 } @test "MRSC2 H2O cc-pVDZ" {