Page MenuHomeHEPForge
Files F11221215

No OneTemporary
Actions

View Options

Index: trunk/src/omega/tests/test_openmp.f90
===================================================================
--- trunk/src/omega/tests/test_openmp.f90 (revision 0)
+++ trunk/src/omega/tests/test_openmp.f90 (revision 1928)
@@ -0,0 +1,169 @@
+! $Id$
+! driver.f90 -- O'Mega self test driver
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! Copyright (C) 1999-2009 by
+! Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
+! Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
+! Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
+!
+! WHIZARD is free software; you can redistribute it and/or modify it
+! under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 2, or (at your option)
+! any later version.
+!
+! WHIZARD is distributed in the hope that it will be useful, but
+! WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+program test_openmp
+
+ use omp_lib
+
+ use kinds
+ use constants
+ use parameters_qcd
+ use amplitude_openmp
+
+ implicit none
+
+ integer, parameter :: NOUT = 3
+ integer, parameter :: NCALLS = 2000
+ real(kind=double), parameter :: ROOTS = 1000
+
+ real(kind=double) :: amp2, elapsed
+ integer :: max_threads, num_threads
+
+ call init_parameters
+
+ max_threads = omp_get_max_threads ()
+ write (unit = *, fmt = "(1X, 'max. threads: ', I3)") max_threads
+
+ call omp_set_dynamic (.true.)
+ call evaluate (NCALLS, ROOTS, 1, 1, amp2, elapsed)
+ write (unit = *, fmt = "(1X, A, F8.4, A, F8.4, A, E10.4)") &
+ ' dynamic: elapsed ', elapsed, ' seconds, elapsed * #threads: ', &
+ elapsed * max_threads, ' seconds, amp2 = ', amp2
+
+ call omp_set_dynamic (.false.)
+ do num_threads = 1, max_threads
+ call omp_set_num_threads (num_threads)
+ call evaluate (NCALLS, ROOTS, 1, 1, amp2, elapsed)
+ write (unit = *, fmt = "(1X, A, I2, A, F8.4, A, F8.4, A, E10.4)") &
+ '#threads = ', num_threads, ', elapsed ', elapsed, &
+ ' seconds, elapsed * #threads: ', elapsed*num_threads, &
+ ' seconds, amp2 = ', amp2
+ end do
+
+ stop 0
+
+ contains
+
+ subroutine evaluate (n, roots, flv, hel, amp2, elapsed)
+ integer, intent(in) :: n
+ real(kind=default), intent(in) :: roots
+ integer, intent(in) :: flv, hel
+ real(kind=double), intent (out) :: amp2, elapsed
+
+ real(kind=double) :: wtime_start, wtime
+ real(kind=double) :: sum_amp2
+ real(kind=default) :: p(0:3,2+NOUT)
+ integer :: i, size
+ integer, dimension(:), allocatable :: seed
+
+ call random_seed (size)
+ allocate (seed(size))
+ seed = 42
+ call random_seed (put = seed)
+ deallocate (seed)
+
+ call beams (roots, 0.0_default, 0.0_default, p(:,1), p(:,2))
+ sum_amp2 = 0
+
+ wtime_start = omp_get_wtime ()
+ do i = 1, n
+ call massless_isotropic_decay (roots, p(:,3:))
+ call new_event (p)
+ sum_amp2 = sum_amp2 + color_sum (1, 1)
+ end do
+ elapsed = omp_get_wtime () - wtime_start
+
+ amp2 = sum_amp2 / n
+
+ end subroutine evaluate
+
+ pure function dot (p, q) result (pq)
+ real(kind=default), dimension(0:), intent(in) :: p, q
+ real(kind=default) :: pq
+ pq = p(0)*q(0) - dot_product (p(1:), q(1:))
+ end function dot
+
+ pure function mass2 (p) result (m2)
+ real(kind=default), dimension(0:), intent(in) :: p
+ real(kind=default) :: m2
+ m2 = p(0)*p(0) - p(1)*p(1) - p(2)*p(2) - p(3)*p(3)
+ end function mass2
+
+ pure subroutine beams (roots, m1, m2, p1, p2)
+ real(kind=default), intent(in) :: roots, m1, m2
+ real(kind=default), dimension(0:), intent(out) :: p1, p2
+ real(kind=default) :: m12, m22
+ m12 = m1**2
+ m22 = m2**2
+ p1(0) = (roots**2 + m12 - m22) / (2*roots)
+ p1(1:2) = 0
+ p1(3) = sqrt (p1(0)**2 - m12)
+ p2(0) = roots - p1(0)
+ p2(1:3) = - p1(1:3)
+ end subroutine beams
+
+ ! The massless RAMBO algorithm
+ subroutine massless_isotropic_decay (roots, p)
+ real(kind=default), intent(in) :: roots
+ real(kind=default), dimension(0:,:), intent(out) :: p
+ real(kind=default), dimension(0:3,size(p,dim=2)) :: q
+ real(kind=default), dimension(0:3) :: qsum
+ real(kind=default), dimension(4) :: ran
+ real(kind=default) :: c, s, f, qabs, x, r, z
+ integer :: k
+ ! Generate isotropic null vectors
+ do k = 1, size (p, dim = 2)
+ call random_number (ran)
+ ! generate a x*exp(-x) distribution for q(0,k)
+ q(0,k)= -log(ran(1)*ran(2))
+ c = 2*ran(3)-1
+ f = 2*PI*ran(4)
+ s = sqrt(1-c*c)
+ q(2,k) = q(0,k)*s*sin(f)
+ q(3,k) = q(0,k)*s*cos(f)
+ q(1,k) = q(0,k)*c
+ enddo
+ ! Boost and rescale the vectors
+ qsum = sum (q, dim = 2)
+ qabs = sqrt (dot (qsum, qsum))
+ x = roots/qabs
+ do k = 1, size (p, dim = 2)
+ r = dot (q(0:,k), qsum) / qabs
+ z = (q(0,k)+r)/(qsum(0)+qabs)
+ p(1:3,k) = x*(q(1:3,k)-qsum(1:3)*z)
+ p(0,k) = x*r
+ enddo
+ end subroutine massless_isotropic_decay
+
+ subroutine expect (x, y, tolerance)
+ real(kind=default), intent(in) :: x, y
+ integer, intent(in) :: tolerance
+ if (abs (x - y) .gt. tolerance * epsilon (max (x, y))) then
+ stop 1
+ end if
+ end subroutine expect
+
+end program test_openmp
+
Property changes on: trunk/src/omega/tests/test_openmp.f90
___________________________________________________________________
Added: svn:mergeinfo
Merged /branches/ohl/omega-development/cross_flavor_cse/src/omega/tests/people/tho/main.f90:r1230-1335
Merged /branches/ohl/omega-development/process-filter/src/omega/tests/test_color_factors.f90:r1832-1851
Merged /branches/ohl/omega-development/jets/src/omega/tests/driver.f90:r1662-1699
Added: svn:keywords
## -0,0 +1 ##
+Author Date Id Revision HeadURL URL
\ No newline at end of property
Index: trunk/src/omega/tests/Makefile.am
===================================================================
--- trunk/src/omega/tests/Makefile.am (revision 1927)
+++ trunk/src/omega/tests/Makefile.am (revision 1928)
@@ -1,103 +1,120 @@
# Makefile.am -- Makefile for O'Mega within and without WHIZARD
# $Id$
##
## Process this file with automake to produce Makefile.in
##
########################################################################
#
# Copyright (C) 1999-2010 by
# Wolfgang Kilian <kilian@hep.physik.uni-siegen.de>
# Thorsten Ohl <ohl@physik.uni-wuerzburg.de>
# Juergen Reuter <juergen.reuter@physik.uni-freiburg.de>
#
# WHIZARD is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.
#
# WHIZARD is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
########################################################################
SUBDIRS = MSSM SM people
EXTRA_DIST = $(srcdir)/test_functions \
test_qed_eemm test_qed_eeee \
test_sm_eemm test_sm_eeee test_sm_uugg
TESTS = \
test_qed_eemm test_qed_eeee \
test_sm_eemm test_sm_eeee test_sm_uugg \
test2_qed_eemm \
test_color_factors
+if OMEGA_WITH_OPENMP
+TESTS += test_openmp
+endif
+
XFAIL_TESTS =
EXTRA_PROGRAMS = \
test2_qed_eemm \
- test_color_factors
+ test_color_factors \
+ test_openmp
test2_qed_eemm_SOURCES = test2_qed_eemm.f90 parameters_qed.f90
nodist_test2_qed_eemm_SOURCES = amplitude_qed_eemm.f90
test2_qed_eemm_LDADD = $(top_builddir)/src/libomega_core.la
test_color_factors_SOURCES = test_color_factors.f90 parameters_qcd.f90
nodist_test_color_factors_SOURCES = amplitude_color_factors.f90
test_color_factors_LDADD = $(top_builddir)/src/libomega_core.la
+test_openmp_SOURCES = test_openmp.f90 parameters_qcd.f90
+nodist_test_openmp_SOURCES = amplitude_openmp.f90
+test_openmp_LDADD = $(top_builddir)/src/libomega_core.la
+
OMEGA_QED = $(top_builddir)/bin/omega_QED.opt
OMEGA_QED_OPTS = -target:parameter_module parameters_qed
OMEGA_QCD = $(top_builddir)/bin/omega_QCD.opt
OMEGA_QCD_OPTS = -target:parameter_module parameters_qcd
AM_FCFLAGS = -I$(top_builddir)/src
if OMEGA_WITH_OPENMP
AM_FCFLAGS += $(OPENMP_FCFLAGS)
endif
amplitude_qed_eemm.f90: $(OMEGA_QED) Makefile
$(OMEGA_QED) $(OMEGA_QED_OPTS) -target:module amplitude_qed_eemm \
-scatter "e+ e- -> m+ m-" > $@
amplitude_color_factors.f90: $(OMEGA_QCD) Makefile
$(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_color_factors \
-scatter "u ubar -> gl" > $@
+amplitude_openmp.f90: $(OMEGA_QCD) Makefile
+ $(OMEGA_QCD) $(OMEGA_QCD_OPTS) -target:module amplitude_openmp \
+ -scatter "gl gl -> gl gl gl" > $@
+
test2_qed_eemm.o: amplitude_qed_eemm.o
test2_qed_eemm.o: parameters_qed.o
amplitude_qed_eemm.o: parameters_qed.o
test_color_factors.o: amplitude_color_factors.o
test_color_factors.o: parameters_qcd.o
amplitude_color_factors.o: parameters_qcd.o
+test_openmp.o: amplitude_openmp.o
+test_openmp.o: parameters_qcd.o
+amplitude_openmp.o: parameters_qcd.o
+
installcheck-local:
PATH=$(bindir):$$PATH; export PATH; \
LD_LIBRARY_PATH=$(pkglibdir):$$LD_LIBRARY_PATH; export LD_LIBRARY_PATH; \
omega_QED.opt $(OMEGA_QED_OPTS) -scatter "e+ e- -> m+ m-" \
-target:module amplitude_qed_eemm > amplitude_qed_eemm.f90; \
$(FC) $(FCFLAGS) -I$(pkgincludedir) -L$(pkglibdir) \
$(srcdir)/parameters_qed.f90 amplitude_qed_eemm.f90 \
$(srcdir)/test2_qed_eemm.f90 -lomega_core; \
./a.out
########################################################################
clean-local:
rm -f a.out gmon.out $(OMEGA_CACHES) *.$(FC_MODULE_EXT) *.o amplitude_*.f90 \
$(EXTRA_PROGRAMS)
########################################################################
## The End.
########################################################################

File Metadata

Mime Type
text/x-diff
Expires
Wed, May 14, 10:04 AM (1 d, 13 h)
Storage Engine
blob
Storage Format
Raw Data
Storage Handle
5111034
Default Alt Text
(10 KB)

Event Timeline