Update the Fortran examples

examples/fortran/Makefile

@@ -6,12 +6,14 @@ LHAPDF_LIBS != pkg-config lhapdf --libs
 %.o: %.f90
 	$(FC) $(FFLAGS) -c $<
 
-all: pineappl.o dyaa.o test.o
+all: pineappl.o dyaa.o test.o test_v1.o
 	$(FC) $(FFLAGS) dyaa.o pineappl.o $(PINEAPPL_LIBS) -o dyaa
 	$(FC) $(FFLAGS) test.o pineappl.o $(PINEAPPL_LIBS) -o test
+	$(FC) $(FFLAGS) test_v1.o pineappl.o $(PINEAPPL_LIBS) -o test_v1
 
-lhapdf_example: pineappl.o lhapdf_example.o
+lhapdf_examples: pineappl.o lhapdf_example.o lhapdf_example_v1.o
 	$(FC) $(FFLAGS) lhapdf_example.o pineappl.o $(LHAPDF_LIBS) $(PINEAPPL_LIBS) -o lhapdf_example
+	$(FC) $(FFLAGS) lhapdf_example_v1.o pineappl.o $(LHAPDF_LIBS) $(PINEAPPL_LIBS) -o lhapdf_example_v1
 
 clean:
-	rm -f *.o *.mod dyaa test lhapdf_example
+	rm -f *.o *.mod dyaa test test_v1 lhapdf_example lhapdf_example_v1

examples/fortran/lhapdf_example.f90

@@ -10,13 +10,13 @@ program lhapdf_example
     type(pineappl_lumi) :: lumi
     type(pineappl_keyval) :: key_vals
 
-    procedure (pineappl_xfx), pointer :: xfx
-    procedure (pineappl_alphas), pointer :: alphas
+    type(pineappl_xfx) :: xfx
+    type(pineappl_alphas) :: alphas
 
     integer, target :: flags(2)
 
     lumi = pineappl_lumi_new()
-    call pineappl_lumi_add(lumi, 2, [0, 0, 1, -1, 2, -2], [1.0_dp, 1.0_dp, 1.0_dp])
+    call pineappl_lumi_add(lumi, 3, [0, 0, 1, -1, 2, -2], [1.0_dp, 1.0_dp, 1.0_dp])
 
     key_vals = pineappl_keyval_new()
     grid = pineappl_grid_new(lumi, 1, [2, 0, 0, 0], 2, [0.0_dp, 1.0_dp, 2.0_dp], key_vals)
@@ -28,19 +28,19 @@ program lhapdf_example
     call lhapdf_initpdfset_byname(1, "nCTEQ15FullNuc_208_82")
 
     ! calling pineappl_grid_convolve without any flags
-    xfx => xfx_test1
-    alphas => alphas_test1
+    xfx = pineappl_xfx(xfx_test1)
+    alphas = pineappl_alphas(alphas_test1)
     write(*, *) "first pineappl_grid_convolve_with_one: "
     write(*, *) pineappl_grid_convolve_with_one(grid, 2212, xfx, alphas, &
-        [.true., .true.], [.true., .true.], 1.0_dp, 1.0_dp)
+        [.true.], [.true.], 1.0_dp, 1.0_dp)
 
     ! calling pineappl_grid_convolve with two integer flags that are used in xfx_test2 and alphas_test2 to determine the set and member indices
-    xfx => xfx_test2
-    alphas => alphas_test2
+    xfx = pineappl_xfx(xfx_test2)
+    alphas = pineappl_alphas(alphas_test2)
     flags = [1, 0]
     write(*, *) "second pineappl_grid_convolve_with_one: "
     write(*, *) pineappl_grid_convolve_with_one(grid, 2212, xfx, alphas, &
-        [.true., .true.], [.true., .true.], 1.0_dp, 1.0_dp, c_loc(flags(1)))
+        [.true.], [.true.], 1.0_dp, 1.0_dp, c_loc(flags(1)))
 contains
 
     ! Passing a Fortran procedure to C needs the iso_c_binding
@@ -99,7 +99,7 @@ function alphas_test2(q2, state) bind(c)
 
         call c_f_pointer(state, flags, [2])
 
-        call lhapdf_alphasq2(0, 0, q2, alphas_test2)
+        call lhapdf_alphasq2(flags(1), flags(2), q2, alphas_test2)
     end function
 
 end program lhapdf_example

examples/fortran/lhapdf_example_v1.f90

@@ -0,0 +1,132 @@
+program lhapdf_example
+    use iso_c_binding
+    use pineappl
+
+    implicit none
+
+    integer, parameter :: dp = kind(0.0d0)
+
+    type(pineappl_grid) :: grid
+    type(pineappl_lumi) :: channels
+    type(pineappl_kinematics) :: kinematics(3)
+    type(pineappl_interp_tuples) :: interpolations(3)
+
+    type (pineappl_xfx) :: xfx(2)
+    type (pineappl_alphas) :: alphas
+
+    integer(kind(pineappl_reweight_meth)) :: q2_reweight
+    integer(kind(pineappl_reweight_meth)) :: x_reweight
+    integer(kind(pineappl_map)) :: q2_mapping
+    integer(kind(pineappl_map)) :: x_mapping
+    integer(kind(pineappl_interp_meth)) :: interpolation_meth
+
+    integer, target :: flags(2)
+
+    channels = pineappl_channel_new()
+    call pineappl_channel_add(channels, 3, 2, [0, 0, 1, -1, 2, -2], [1.0_dp, 1.0_dp, 1.0_dp])
+
+    kinematics = [&
+        pineappl_kinematics(pineappl_scale, 0), &
+        pineappl_kinematics(pineappl_x, 0), &
+        pineappl_kinematics(pineappl_x, 1) &
+    ]
+
+    q2_reweight = pineappl_no_reweight
+    x_reweight = pineappl_applgrid_x
+    q2_mapping = pineappl_applgrid_h0
+    x_mapping = pineappl_applgrid_f2
+    interpolation_meth = pineappl_lagrange
+    interpolations = [ &
+        pineappl_interp_tuples(1e2, 1e8, 40, 3, q2_reweight, q2_mapping, interpolation_meth), &
+        pineappl_interp_tuples(2e-7, 1.0, 50, 3, x_reweight, x_mapping, interpolation_meth), &
+        pineappl_interp_tuples(2e-7, 1.0, 50, 3, x_reweight, x_mapping, interpolation_meth) &
+    ]
+
+    grid = pineappl_grid_new2(pineappl_pdg, channels, 1, [2_1, 0_1, 0_1, 0_1], 2, &
+        [0.0_dp, 1.0_dp, 2.0_dp], 2, [pineappl_unpol_pdf, pineappl_unpol_pdf], [2212, 2212], kinematics, interpolations, [1, 1, 0])
+
+    call pineappl_grid_fill_all2(grid, 0, 0.5_dp, [100.0_dp, 0.5_dp, 0.5_dp], [0.5_dp, 0.5_dp, 0.5_dp])
+    call pineappl_grid_fill_all2(grid, 0, 1.5_dp, [100.0_dp, 0.5_dp, 0.5_dp], [1.5_dp, 1.5_dp, 1.5_dp])
+
+    call lhapdf_initpdfset_byname(0, "nCTEQ15_1_1")
+    ! call lhapdf_initpdfset_byname(0, "nCTEQ15FullNuc_208_82")
+    call lhapdf_initpdfset_byname(1, "nCTEQ15FullNuc_208_82")
+
+    ! write(*, *) "xfx_test1: ", xfx_test1(0, 0.5_dp, 100.0_dp, c_null_ptr)
+
+    ! calling pineappl_grid_convolve without any flags
+    xfx = pineappl_xfx(xfx_test1)
+    alphas = pineappl_alphas(alphas_test1)
+    write(*, *) "first pineappl_grid_convolve: "
+    write(*, *) pineappl_grid_convolve(grid, [xfx, xfx], alphas, &
+        [.true.], [.true.], [0, 1], 1, [1.0_dp, 1.0_dp, 1.0_dp])
+
+    ! calling pineappl_grid_convolve with two integer flags that are used in xfx_test2 and alphas_test2 to determine the set and member indices
+    xfx = pineappl_xfx(xfx_test2)
+    alphas = pineappl_alphas(alphas_test2)
+    flags = [1, 0]
+    write(*, *) "second pineappl_grid_convolve: "
+    write(*, *) pineappl_grid_convolve(grid, [xfx, xfx], alphas, &
+        [.true.], [.true.], [0, 1], 1, [1.0_dp, 1.0_dp, 1.0_dp], c_loc(flags(1)))
+contains
+
+    ! Passing a Fortran procedure to C needs the iso_c_binding
+    function xfx_test1(pdg_id, x, q2, state) bind(c)
+        use iso_c_binding
+
+        implicit none
+
+        integer(c_int32_t), value, intent(in) :: pdg_id
+        real(c_double), value, intent(in)     :: x, q2
+        type(c_ptr), value, intent(in)        :: state
+        real(c_double)                        :: xfx_test1
+
+        call lhapdf_xfxq2(0, 0, pdg_id, x, q2, xfx_test1)
+    end function
+
+    function xfx_test2(pdg_id, x, q2, state) bind(c)
+        use iso_c_binding
+
+        implicit none
+
+        integer(c_int32_t), value, intent(in) :: pdg_id
+        real(c_double), value, intent(in)     :: x, q2
+        type(c_ptr), value, intent(in)        :: state
+        real(c_double)                        :: xfx_test2
+
+        integer, pointer :: flags(:)
+
+        call c_f_pointer(state, flags, [2])
+
+        call lhapdf_xfxq2(flags(1), flags(2), pdg_id, x, q2, xfx_test2)
+    end function
+
+    function alphas_test1(q2, state) bind(c)
+        use iso_c_binding
+
+        implicit none
+
+        real(c_double), value, intent(in) :: q2
+        type(c_ptr), value, intent(in)    :: state
+        real(c_double)                    :: alphas_test1
+
+        call lhapdf_alphasq2(0, 0, q2, alphas_test1)
+    end function
+
+    function alphas_test2(q2, state) bind(c)
+        use iso_c_binding
+
+        implicit none
+
+        real(c_double), value, intent(in) :: q2
+        type(c_ptr), value, intent(in)    :: state
+        real(c_double)                    :: alphas_test2
+
+        integer, pointer :: flags(:)
+
+        call c_f_pointer(state, flags, [2])
+
+        call lhapdf_alphasq2(flags(1), flags(2), q2, alphas_test2)
+    end function
+
+end program lhapdf_example

examples/fortran/test.f90

@@ -14,8 +14,8 @@ program test_pineappl
 
     character(len=:), allocatable :: string
 
-    procedure (pineappl_xfx), pointer    :: xfx1, xfx2
-    procedure (pineappl_alphas), pointer :: alphas
+    type(pineappl_xfx)    :: xfx1, xfx2
+    type(pineappl_alphas) :: alphas
 
     lumi = pineappl_lumi_new()
     call pineappl_lumi_add(lumi, 2, [0, 0, 1, -1], [1.0_dp, 1.0_dp])
@@ -72,6 +72,16 @@ program test_pineappl
 
     lumi2 = pineappl_grid_lumi(grid)
 
+    if (pineappl_lumi_count(lumi2) /= 1) then
+        write(*, *) "pineappl_lumi_count(): ", pineappl_lumi_count(lumi2)
+        error stop "error: pineappl_lumi_count"
+    end if
+
+    if (pineappl_lumi_combinations(lumi2, 0) /= 2) then
+        write(*, *) "pineappl_lumi_combinations(): ", pineappl_lumi_combinations(lumi2, 0)
+        error stop "error: pineappl_lumi_combinations"
+    end if
+
     grid2 = pineappl_grid_new(lumi, 1, [2, 0, 0, 0], 1, [2.0_dp, 3.0_dp], key_vals)
 
     call pineappl_grid_merge_and_delete(grid, grid2)
@@ -132,9 +142,9 @@ program test_pineappl
         error stop "error: pineappl_keyval_string"
     end if
 
-    xfx1 => xfx1_test
-    xfx2 => xfx2_test
-    alphas => alphas_test
+    xfx1 = pineappl_xfx(xfx1_test)
+    xfx2 = pineappl_xfx(xfx2_test)
+    alphas = pineappl_alphas(alphas_test)
 
     result = pineappl_grid_convolve_with_one(grid, 2212, xfx1, alphas, &
         [.true., .true.], [.true., .true.], 1.0_dp, 1.0_dp)