Fortran argument must be Allocatable in Python F2PY
Question:
I am currently trying to compile Fortran scripts in the Python command terminal into Python modules using the numpy.f2py function as displayed below:
python -m numpy.f2py -c -m matching_pairs Matching_Pairs_V2.F90 --fcompiler=gnu95 --compiler=mingw32
It works fine for two other Fortran scripts and I am able to import them in Python. However, when I run this code command for this specific file I get the following error:
C:Usersweb200AppDataLocalTemptmpst9o9whosrc.win-amd64-3.9matching_pairs-f2pywrappers2.f90:48:64:
&, frame_sint_cutoff, lambda_min, s0_vector, motion_angle, mask, se&
1
Error: Actual argument for 'mask' must be ALLOCATABLE at (1)
After searching through the script I found the subroutine I think is causing the error:
! Filtering of monorays
subroutine frame_windows_filtering(mono_rays, mono_rays_len, TransMatrix, frame_sint_cutoff, lambda_min, S0_vector,&
motion_angle, mask, selected_transformed_mono_rays)
! Input/Output variables
REAL*8, INTENT(IN) :: frame_sint_cutoff, lambda_min
REAL*8, DIMENSION(:,:), INTENT(IN) :: mono_rays
REAL*8, DIMENSION(:), INTENT(IN) :: mono_rays_len
REAL*8, DIMENSION(3,3), INTENT(IN) :: TransMatrix
REAL*8, DIMENSION(3), INTENT(IN) :: S0_vector
REAL*8, INTENT(IN) :: motion_angle
REAL*8, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: selected_transformed_mono_rays
LOGICAL,DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: mask
REAL*8:: max_h_len, Theta, cos_min, cos_max
REAL*8, DIMENSION(:,:), ALLOCATABLE :: transformed_mono_rays
REAL*8,DIMENSION(:,:), ALLOCATABLE :: normalized_transformed_mono_rays
REAL*8,DIMENSION(:), ALLOCATABLE :: transformed_mono_rays_normes
REAL*8, DIMENSION(:), ALLOCATABLE :: cos_angles
LOGICAL,DIMENSION(:), ALLOCATABLE :: mask_max_h_len, mask_max_coords, mask_min_coords
INTEGER :: mono_rays_size, i, selection_size
! Max h len max
max_h_len = 2.0 * frame_sint_cutoff/lambda_min
! Perform transformation on monorays
mono_rays_size = size(mono_rays_len)
ALLOCATE(transformed_mono_rays(mono_rays_size,3))
ALLOCATE(normalized_transformed_mono_rays(mono_rays_size,3))
ALLOCATE(transformed_mono_rays_normes(mono_rays_size))
ALLOCATE(cos_angles(mono_rays_size))
ALLOCATE(mask_max_h_len(mono_rays_size))
ALLOCATE(mask_max_coords(mono_rays_size))
ALLOCATE(mask_min_coords(mono_rays_size))
IF (ALLOCATED(mask)) THEN
DEALLOCATE(mask)
END IF
ALLOCATE(mask(mono_rays_size))
transformed_mono_rays=matmul(mono_rays,transpose(TransMatrix))
transformed_mono_rays_normes = sqrt(sum(transformed_mono_rays**2,2))
! Normalize transformed monorays
DO i = 1, 3
normalized_transformed_mono_rays(:,i) = transformed_mono_rays(:,i)/transformed_mono_rays_normes
END DO
! Cos limits
Theta = dasin(frame_sint_cutoff)
cos_max = dsin(motion_angle)
cos_min = -dsin(motion_angle+Theta)
cos_angles = MATMUL(normalized_transformed_mono_rays,S0_vector)
! Filtering of mono rays per frame considering ranges of coordinates
! Filtering of mono rays
mask_max_h_len = (mono_rays_len .le. max_h_len)
! Max coordinates filtering
mask_max_coords = (cos_angles <= cos_max)
! Min coordinates filtering
mask_min_coords = (cos_angles >= cos_min)
! Total mask
mask = mask_max_h_len.and.mask_max_coords.and.mask_min_coords
selection_size = count(mask .eqv..True.)
IF (ALLOCATED(selected_transformed_mono_rays)) THEN
DEALLOCATE(selected_transformed_mono_rays)
END IF
ALLOCATE(selected_transformed_mono_rays(selection_size,3))
! Indices of monoray vectors, normalized monoray vectors
!return mask, normalized_transformed_mono_rays(mask,:)
selected_transformed_mono_rays = RESHAPE(PACK(normalized_transformed_mono_rays, SPREAD(mask,2,3)), (/selection_size,3/))
DEALLOCATE(transformed_mono_rays)
DEALLOCATE(normalized_transformed_mono_rays)
DEALLOCATE(transformed_mono_rays_normes)
DEALLOCATE(cos_angles)
DEALLOCATE(mask_max_h_len)
DEALLOCATE(mask_max_coords)
DEALLOCATE(mask_min_coords)
end subroutine frame_windows_filtering
I am not fluent in Fortran so I am not sure how I fix this. Naively to me it looks like the "mask" variable is already allocatable.
Edits
Thank you for your quick and insightful responses. The original Fortran script was quite long so I’ve provided a minimised version below that still replicates the original error. The subroutine matching_per_frame calls the subroutine frame_windows_filtering using the variable ‘frame_mono_rays_mask’ in place of the ‘mask’ variable which is seemingly causing the error.
The variable ‘frame_mono_rays_mask’ doesn’t have the INTENT(OUT) argument attached to it but the ‘mask’ variable does. Apart from that they seem the same.
For anyone who is interested in the original source code, it can be found at http://sourceforge.net/projects/laueutil/ in the source_fortran_module folder and the script is labelled Matching_Pairs.F90.
MODULE matching_pairs
! All Subroutines must be public to build a PYTHON/FORTRAN module
! using F2PY command
IMPLICIT NONE
PUBLIC :: matching_per_frame
PUBLIC :: frame_windows_filtering
PUBLIC :: quicksort
CONTAINS
! matching_per_frame:
! - Optimize motion angle and shape angle limits
! - Identify normalized H-vectors with unique neighbouring mono ray
!
! Input parameters
! mono_rays : Monochromatic rays
! mono_rays_len : Normes of monochromatic rays
! unit_expts : Normalized expts prefiltered (maxsint, I_limit)
! unit_expts_I : Intensities of normalized expts
! unit_expts_sint : Sintheta of normalized expts
! S0_vector : S0 vector in goniometer basis
! TransMatrix : Transformation matrix
! g_min_I : Global minimal I
! g_motion_ang : Global crystal motion angle
! g_shape_ang : Global cell shape angle
! min_I_step : Minimal I step
! motion_ang_step : Crystal motion angle step
! shape_ang_step : Cell shape angle step
! frame_sint_cutoff : Max sintheta cutoff
! lambda_min : Minimal possible lambda
! nb_expt_pairs : Expected Number of (expt, monoray) pairs
! nb_mono_rays : Number of monochromatic rays
! nb_unit_expts : Number of normalized expts
! Output parameters
! final_array_unique_pair_indices : Identified (expt, monoray) pairs
! l_min_I : Frame intensity limit
! best_l_motion_ang : Frame crystal motion angle limit
! best_l_shape_ang : Frame cell shape angle limit
SUBROUTINE matching_per_frame (mono_rays, mono_rays_len, &
unit_expts, unit_expts_I, unit_expts_sint, S0_vector, &
TransMatrix, g_min_I, g_motion_ang, &
g_shape_ang, min_I_step, motion_ang_step, &
shape_ang_step, lambda_min, nb_expt_pairs, &
nb_mono_rays,nb_unit_expts,final_array_unique_pair_indices, &
l_min_I, best_l_motion_ang, best_l_shape_ang, nb_matched_pairs)
! Input/Output variables
REAL*8, INTENT(IN) :: g_min_I, g_motion_ang, g_shape_ang
REAL*8, INTENT(IN) :: min_I_step, motion_ang_step, shape_ang_step
REAL*8, INTENT(IN) :: lambda_min
INTEGER, INTENT(IN) :: nb_expt_pairs, nb_unit_expts, nb_mono_rays
REAL*8, DIMENSION(nb_unit_expts,3), INTENT(IN) :: unit_expts
REAL*8, DIMENSION(nb_unit_expts), INTENT(IN) :: unit_expts_I, unit_expts_sint
REAL*8, DIMENSION(3), INTENT(IN) :: S0_vector
REAL*8, DIMENSION(nb_mono_rays,3), INTENT(IN) :: mono_rays
REAL*8, DIMENSION(nb_mono_rays), INTENT(IN) :: mono_rays_len
REAL*8, DIMENSION(3,3), INTENT(IN) :: TransMatrix
INTEGER,DIMENSION(nb_expt_pairs,2), INTENT(OUT) :: final_array_unique_pair_indices
REAL*8, INTENT(OUT) :: l_min_I, best_l_motion_ang, best_l_shape_ang
INTEGER, INTENT(OUT) :: nb_matched_pairs
! Local variables
REAL*8 :: frame_sint_cutoff ! Cutoff sint applied on monorays
REAL*8 :: rounded_g_min_I, rounded_g_motion_ang, rounded_g_shape_ang ! Rounded limit values
REAL*8, DIMENSION(nb_unit_expts) :: sorted_unit_expts_I ! Sorted intensity array of unit vectors
REAL*8, PARAMETER :: deg2rad = 0.017453292519943295d0
INTEGER, DIMENSION(nb_unit_expts) :: unit_expts_indices
INTEGER, DIMENSION(nb_mono_rays) :: mono_rays_indices
INTEGER :: nb_motion_ang_steps, nb_shape_ang_steps
REAL*8, DIMENSION(:), ALLOCATABLE :: motion_ang_range, shape_ang_range
INTEGER, DIMENSION(:), ALLOCATABLE :: frame_mono_rays_indices
INTEGER :: I_limit_indice, nb_filtered_expts
REAL*8 :: I_limit
LOGICAL,DIMENSION(nb_unit_expts)::I_limit_mask
REAL*8, DIMENSION(:),ALLOCATABLE::filtered_unit_expts_I, filtered_unit_expts_sint
REAL*8, DIMENSION(:,:),ALLOCATABLE :: filtered_unit_expts
INTEGER,DIMENSION(:),ALLOCATABLE::filtered_unit_expts_indices
LOGICAL,DIMENSION(:), ALLOCATABLE :: frame_mono_rays_mask
REAL*8, DIMENSION(:,:), ALLOCATABLE :: frame_mono_rays
REAL*8,DIMENSION(:,:),ALLOCATABLE :: cos_delta_angles_monos_expts
LOGICAL, DIMENSION(:,:), ALLOCATABLE :: cos_delta_angles_monos_expts_mask
INTEGER, DIMENSION(:), ALLOCATABLE :: array_nb_neighbours
INTEGER, DIMENSION(:), ALLOCATABLE :: filtered_array_nb_neighbours
INTEGER :: i
! Check extremum values specified in input
rounded_g_min_I = min_I_step*FLOOR(g_min_I/min_I_step)
! Definition of crystal motion angle range
nb_motion_ang_steps = CEILING(g_motion_ang/motion_ang_step)
rounded_g_motion_ang = motion_ang_step * float(nb_motion_ang_steps)
IF (ALLOCATED(motion_ang_range)) THEN
DEALLOCATE(motion_ang_range)
END IF
ALLOCATE(motion_ang_range(nb_motion_ang_steps))
DO i = 1, nb_motion_ang_steps
motion_ang_range(i) = float(i) * motion_ang_step
END DO
! Definition of cell shape angle range
nb_shape_ang_steps = CEILING(g_shape_ang/shape_ang_step)
rounded_g_shape_ang = shape_ang_step * float(nb_shape_ang_steps)
IF (ALLOCATED(shape_ang_range)) THEN
DEALLOCATE(shape_ang_range)
END IF
ALLOCATE(shape_ang_range(nb_shape_ang_steps))
DO i = 1, nb_shape_ang_steps
shape_ang_range(i) = float(i) * shape_ang_step
END DO
! Initialisation of array of expt global indices before filtering
! Global indices of unit expts
DO i = 1, nb_unit_expts
unit_expts_indices(i) = i
END DO
! Global indices of mono rays
DO i = 1, nb_mono_rays
mono_rays_indices(i) = i
END DO
! Selection of the largest intensity unit expts
! The expected number of pairs is smaller than the number of expt vectors
IF (nb_expt_pairs .le. nb_unit_expts) THEN
! Sorting of intensity of normalized expt vectors in increasing order
sorted_unit_expts_I = unit_expts_I
call quicksort(sorted_unit_expts_I, unit_expts_indices)
I_limit_indice = nb_unit_expts - nb_expt_pairs + 1
I_limit = sorted_unit_expts_I (I_limit_indice)
! Round the intensity limit
l_min_I = dmax1(min_I_step*FLOOR(I_limit/min_I_step), rounded_g_min_I)
I_limit_mask = unit_expts_I .ge. l_min_I
ELSE
sorted_unit_expts_I = unit_expts_I
call quicksort(sorted_unit_expts_I, unit_expts_indices)
I_limit_mask = unit_expts_I .ge. rounded_g_min_I
l_min_I = rounded_g_min_I
END IF
! Selection of the first Nbexpectedpairs expts with the largest intensities
nb_filtered_expts = min(COUNT(I_limit_mask .eqv. .True.), nb_expt_pairs)
! Allocation of arrays
IF (ALLOCATED(filtered_unit_expts_I)) THEN
DEALLOCATE(filtered_unit_expts_I)
END IF
ALLOCATE(filtered_unit_expts_I(nb_filtered_expts))
IF (ALLOCATED(filtered_unit_expts_sint)) THEN
DEALLOCATE(filtered_unit_expts_sint)
END IF
IF (ALLOCATED(filtered_unit_expts_sint)) THEN
DEALLOCATE(filtered_unit_expts_sint)
END IF
ALLOCATE(filtered_unit_expts_sint(nb_filtered_expts))
IF (ALLOCATED(filtered_unit_expts_indices)) THEN
DEALLOCATE(filtered_unit_expts_indices)
END IF
ALLOCATE(filtered_unit_expts_indices(nb_filtered_expts))
IF (ALLOCATED(filtered_unit_expts)) THEN
DEALLOCATE(filtered_unit_expts)
END IF
ALLOCATE(filtered_unit_expts(nb_filtered_expts,3))
! Filtering of unit expts according to the intensity threshold
filtered_unit_expts_I = sorted_unit_expts_I (nb_unit_expts-nb_filtered_expts+1:)
filtered_unit_expts_sint = unit_expts_sint (unit_expts_indices(nb_unit_expts-nb_filtered_expts+1:))
filtered_unit_expts_indices = unit_expts_indices(nb_unit_expts-nb_filtered_expts+1:)
filtered_unit_expts = unit_expts(filtered_unit_expts_indices,:)
! If there is no expt vectors
IF (nb_filtered_expts == 0) THEN
final_array_unique_pair_indices = 0
best_l_motion_ang = 0.0
best_l_shape_ang = 0.0
nb_matched_pairs = 0
return
END IF
! Selection of mono rays
! Max sin(theta) value
frame_sint_cutoff = maxval(filtered_unit_expts_sint)
! Selection of monorays in normalized H-vector coordinate ranges by filtering
call frame_windows_filtering(mono_rays, mono_rays_len, &
TransMatrix, frame_sint_cutoff, lambda_min, S0_vector, &
rounded_g_motion_ang, frame_mono_rays_mask, frame_mono_rays)
! Deallocate memory
IF (ALLOCATED(motion_ang_range)) THEN
DEALLOCATE(motion_ang_range)
END IF
IF (ALLOCATED(shape_ang_range)) THEN
DEALLOCATE(shape_ang_range)
END IF
IF (ALLOCATED(array_nb_neighbours)) THEN
DEALLOCATE(array_nb_neighbours)
END IF
IF (ALLOCATED(filtered_array_nb_neighbours)) THEN
DEALLOCATE(filtered_array_nb_neighbours)
END IF
IF (ALLOCATED(filtered_unit_expts_I)) THEN
DEALLOCATE(filtered_unit_expts_I)
END IF
IF (ALLOCATED(filtered_unit_expts_sint)) THEN
DEALLOCATE(filtered_unit_expts_sint)
END IF
IF (ALLOCATED(filtered_unit_expts_indices)) THEN
DEALLOCATE(filtered_unit_expts_indices)
END IF
IF (ALLOCATED(filtered_unit_expts)) THEN
DEALLOCATE(filtered_unit_expts)
END IF
IF (ALLOCATED(frame_mono_rays_indices)) THEN
DEALLOCATE(frame_mono_rays_indices)
END IF
IF (ALLOCATED(cos_delta_angles_monos_expts)) THEN
DEALLOCATE(cos_delta_angles_monos_expts)
END IF
IF (ALLOCATED(cos_delta_angles_monos_expts_mask)) THEN
DEALLOCATE(cos_delta_angles_monos_expts_mask)
END IF
IF (ALLOCATED(frame_mono_rays_mask)) THEN
DEALLOCATE(frame_mono_rays_mask)
END IF
IF (ALLOCATED(frame_mono_rays)) THEN
DEALLOCATE(frame_mono_rays)
END IF
return
END SUBROUTINE matching_per_frame
! Filtering of monorays
subroutine frame_windows_filtering(mono_rays, mono_rays_len, &
TransMatrix, frame_sint_cutoff, lambda_min, S0_vector, &
motion_angle, mask, selected_transformed_mono_rays)
! Input/Output variables
REAL*8, INTENT(IN) :: frame_sint_cutoff, lambda_min
REAL*8, DIMENSION(:,:), INTENT(IN) :: mono_rays
REAL*8, DIMENSION(:), INTENT(IN) :: mono_rays_len
REAL*8, DIMENSION(3,3), INTENT(IN) :: TransMatrix
REAL*8, DIMENSION(3), INTENT(IN) :: S0_vector
REAL*8, INTENT(IN) :: motion_angle
REAL*8, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: &
selected_transformed_mono_rays
LOGICAL,DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: mask
REAL*8:: max_h_len, Theta, cos_min, cos_max
REAL*8, DIMENSION(:,:), ALLOCATABLE :: transformed_mono_rays
REAL*8,DIMENSION(:,:),ALLOCATABLE :: &
normalized_transformed_mono_rays
REAL*8,DIMENSION(:),ALLOCATABLE :: transformed_mono_rays_normes
REAL*8, DIMENSION(:), ALLOCATABLE :: cos_angles
LOGICAL,DIMENSION(:),ALLOCATABLE :: mask_max_h_len, &
mask_max_coords, mask_min_coords
INTEGER :: mono_rays_size, i, selection_size
! Max h len max
max_h_len = 2.0 * frame_sint_cutoff/lambda_min
! Perform transformation on monorays
mono_rays_size = size(mono_rays_len)
ALLOCATE(transformed_mono_rays(mono_rays_size,3))
ALLOCATE(normalized_transformed_mono_rays(mono_rays_size,3))
ALLOCATE(transformed_mono_rays_normes(mono_rays_size))
ALLOCATE(cos_angles(mono_rays_size))
ALLOCATE(mask_max_h_len(mono_rays_size))
ALLOCATE(mask_max_coords(mono_rays_size))
ALLOCATE(mask_min_coords(mono_rays_size))
IF (ALLOCATED(mask)) THEN
DEALLOCATE(mask)
END IF
ALLOCATE(mask(mono_rays_size))
transformed_mono_rays=matmul(mono_rays,transpose(TransMatrix))
transformed_mono_rays_normes = &
sqrt(sum(transformed_mono_rays**2,2))
! Normalize transformed monorays
DO i = 1, 3
normalized_transformed_mono_rays(:,i) = &
transformed_mono_rays(:,i)/transformed_mono_rays_normes
END DO
! Cos limits
Theta = dasin(frame_sint_cutoff)
cos_max = dsin(motion_angle)
cos_min = -dsin(motion_angle+Theta)
cos_angles = MATMUL(normalized_transformed_mono_rays,S0_vector)
! Filtering of mono rays per frame considering ranges of coordinates
! Filtering of mono rays
mask_max_h_len = (mono_rays_len .le. max_h_len)
! Max coordinates filtering
mask_max_coords = (cos_angles <= cos_max)
! Min coordinates filtering
mask_min_coords = (cos_angles >= cos_min)
! Total mask
mask = mask_max_h_len.and.mask_max_coords.and.mask_min_coords
selection_size = count(mask .eqv..True.)
IF (ALLOCATED(selected_transformed_mono_rays)) THEN
DEALLOCATE(selected_transformed_mono_rays)
END IF
ALLOCATE(selected_transformed_mono_rays(selection_size,3))
! Indices of monoray vectors, normalized monoray vectors
!return mask, normalized_transformed_mono_rays(mask,:)
selected_transformed_mono_rays = RESHAPE( &
PACK(normalized_transformed_mono_rays, SPREAD(mask,2,3)), &
(/selection_size,3/))
DEALLOCATE(transformed_mono_rays)
DEALLOCATE(normalized_transformed_mono_rays)
DEALLOCATE(transformed_mono_rays_normes)
DEALLOCATE(cos_angles)
DEALLOCATE(mask_max_h_len)
DEALLOCATE(mask_max_coords)
DEALLOCATE(mask_min_coords)
end subroutine frame_windows_filtering
! quicksort: Recursive subroutine which sorts all values from a 1D-array in increasing order
recursive subroutine quicksort(Values, Indices)
REAL*8, intent(inout), dimension(:) :: Values
INTEGER, intent(inout), dimension(:) :: Indices
integer :: MarkerIndex
! If the size of A is 1, no need to sort
IF (size(Values) .gt. 1) THEN
! Partition selects a threshold value, sorts values
! to put all values smaller than this threshold before
! and to put all values larger than this threshold after
call partition(Values, Indices, MarkerIndex)
! quicksort is applied on the first part [1:IndexOfThreshold] of the array (all values smaller than the threshold)
call quicksort(Values(:MarkerIndex-1),&
Indices(:MarkerIndex-1))
! quicksort is applied on the second part [IndexOfThreshold:nbvalues] (all values larger than the threshold)
call quicksort(Values(MarkerIndex:), Indices(MarkerIndex:))
END IF
end subroutine quicksort
END MODULE Matching_Pairs
Answers:
It seems you just found some Fortran code that would do what you need and you are trying to call it from Python using f2py as is.
That is not going to work. F2py only supports some basic subset of Fortran and does not support many modern ways how arguments can be passed. The subroutine you found uses allocatable dummy arguments. You cannot call it from Python using f2py. F2py simply does not support that.
If you want to call that code from Python using f2py, you will have to write a simpler Fortran subroutine, that will call that subroutine for you.
Also, you should only compile with f2py the code that you actually plan to call from Python. Other code that will only be called inside Fortran, should be compiled normally using a Fortran compiler into an ordinary object file and linked when creating the final library.
I am currently trying to compile Fortran scripts in the Python command terminal into Python modules using the numpy.f2py function as displayed below:
python -m numpy.f2py -c -m matching_pairs Matching_Pairs_V2.F90 --fcompiler=gnu95 --compiler=mingw32
It works fine for two other Fortran scripts and I am able to import them in Python. However, when I run this code command for this specific file I get the following error:
C:Usersweb200AppDataLocalTemptmpst9o9whosrc.win-amd64-3.9matching_pairs-f2pywrappers2.f90:48:64:
&, frame_sint_cutoff, lambda_min, s0_vector, motion_angle, mask, se&
1
Error: Actual argument for 'mask' must be ALLOCATABLE at (1)
After searching through the script I found the subroutine I think is causing the error:
! Filtering of monorays
subroutine frame_windows_filtering(mono_rays, mono_rays_len, TransMatrix, frame_sint_cutoff, lambda_min, S0_vector,&
motion_angle, mask, selected_transformed_mono_rays)
! Input/Output variables
REAL*8, INTENT(IN) :: frame_sint_cutoff, lambda_min
REAL*8, DIMENSION(:,:), INTENT(IN) :: mono_rays
REAL*8, DIMENSION(:), INTENT(IN) :: mono_rays_len
REAL*8, DIMENSION(3,3), INTENT(IN) :: TransMatrix
REAL*8, DIMENSION(3), INTENT(IN) :: S0_vector
REAL*8, INTENT(IN) :: motion_angle
REAL*8, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: selected_transformed_mono_rays
LOGICAL,DIMENSION(:), ALLOCATABLE, INTENT(OUT) :: mask
REAL*8:: max_h_len, Theta, cos_min, cos_max
REAL*8, DIMENSION(:,:), ALLOCATABLE :: transformed_mono_rays
REAL*8,DIMENSION(:,:), ALLOCATABLE :: normalized_transformed_mono_rays
REAL*8,DIMENSION(:), ALLOCATABLE :: transformed_mono_rays_normes
REAL*8, DIMENSION(:), ALLOCATABLE :: cos_angles
LOGICAL,DIMENSION(:), ALLOCATABLE :: mask_max_h_len, mask_max_coords, mask_min_coords
INTEGER :: mono_rays_size, i, selection_size
! Max h len max
max_h_len = 2.0 * frame_sint_cutoff/lambda_min
! Perform transformation on monorays
mono_rays_size = size(mono_rays_len)
ALLOCATE(transformed_mono_rays(mono_rays_size,3))
ALLOCATE(normalized_transformed_mono_rays(mono_rays_size,3))
ALLOCATE(transformed_mono_rays_normes(mono_rays_size))
ALLOCATE(cos_angles(mono_rays_size))
ALLOCATE(mask_max_h_len(mono_rays_size))
ALLOCATE(mask_max_coords(mono_rays_size))
ALLOCATE(mask_min_coords(mono_rays_size))
IF (ALLOCATED(mask)) THEN
DEALLOCATE(mask)
END IF
ALLOCATE(mask(mono_rays_size))
transformed_mono_rays=matmul(mono_rays,transpose(TransMatrix))
transformed_mono_rays_normes = sqrt(sum(transformed_mono_rays**2,2))
! Normalize transformed monorays
DO i = 1, 3
normalized_transformed_mono_rays(:,i) = transformed_mono_rays(:,i)/transformed_mono_rays_normes
END DO
! Cos limits
Theta = dasin(frame_sint_cutoff)
cos_max = dsin(motion_angle)
cos_min = -dsin(motion_angle+Theta)
cos_angles = MATMUL(normalized_transformed_mono_rays,S0_vector)
! Filtering of mono rays per frame considering ranges of coordinates
! Filtering of mono rays
mask_max_h_len = (mono_rays_len .le. max_h_len)
! Max coordinates filtering
mask_max_coords = (cos_angles <= cos_max)
! Min coordinates filtering
mask_min_coords = (cos_angles >= cos_min)
! Total mask
mask = mask_max_h_len.and.mask_max_coords.and.mask_min_coords
selection_size = count(mask .eqv..True.)
IF (ALLOCATED(selected_transformed_mono_rays)) THEN
DEALLOCATE(selected_transformed_mono_rays)
END IF
ALLOCATE(selected_transformed_mono_rays(selection_size,3))
! Indices of monoray vectors, normalized monoray vectors
!return mask, normalized_transformed_mono_rays(mask,:)
selected_transformed_mono_rays = RESHAPE(PACK(normalized_transformed_mono_rays, SPREAD(mask,2,3)), (/selection_size,3/))
DEALLOCATE(transformed_mono_rays)
DEALLOCATE(normalized_transformed_mono_rays)
DEALLOCATE(transformed_mono_rays_normes)
DEALLOCATE(cos_angles)
DEALLOCATE(mask_max_h_len)
DEALLOCATE(mask_max_coords)
DEALLOCATE(mask_min_coords)
end subroutine frame_windows_filtering
I am not fluent in Fortran so I am not sure how I fix this. Naively to me it looks like the "mask" variable is already allocatable.
Edits
Thank you for your quick and insightful responses. The original Fortran script was quite long so I’ve provided a minimised version below that still replicates the original error. The subroutine matching_per_frame calls the subroutine frame_windows_filtering using the variable ‘frame_mono_rays_mask’ in place of the ‘mask’ variable which is seemingly causing the error.
The variable ‘frame_mono_rays_mask’ doesn’t have the INTENT(OUT) argument attached to it but the ‘mask’ variable does. Apart from that they seem the same.
For anyone who is interested in the original source code, it can be found at http://sourceforge.net/projects/laueutil/ in the source_fortran_module folder and the script is labelled Matching_Pairs.F90.
MODULE matching_pairs
! All Subroutines must be public to build a PYTHON/FORTRAN module
! using F2PY command
IMPLICIT NONE
PUBLIC :: matching_per_frame
PUBLIC :: frame_windows_filtering
PUBLIC :: quicksort
CONTAINS
! matching_per_frame:
! - Optimize motion angle and shape angle limits
! - Identify normalized H-vectors with unique neighbouring mono ray
!
! Input parameters
! mono_rays : Monochromatic rays
! mono_rays_len : Normes of monochromatic rays
! unit_expts : Normalized expts prefiltered (maxsint, I_limit)
! unit_expts_I : Intensities of normalized expts
! unit_expts_sint : Sintheta of normalized expts
! S0_vector : S0 vector in goniometer basis
! TransMatrix : Transformation matrix
! g_min_I : Global minimal I
! g_motion_ang : Global crystal motion angle
! g_shape_ang : Global cell shape angle
! min_I_step : Minimal I step
! motion_ang_step : Crystal motion angle step
! shape_ang_step : Cell shape angle step
! frame_sint_cutoff : Max sintheta cutoff
! lambda_min : Minimal possible lambda
! nb_expt_pairs : Expected Number of (expt, monoray) pairs
! nb_mono_rays : Number of monochromatic rays
! nb_unit_expts : Number of normalized expts
! Output parameters
! final_array_unique_pair_indices : Identified (expt, monoray) pairs
! l_min_I : Frame intensity limit
! best_l_motion_ang : Frame crystal motion angle limit
! best_l_shape_ang : Frame cell shape angle limit
SUBROUTINE matching_per_frame (mono_rays, mono_rays_len, &
unit_expts, unit_expts_I, unit_expts_sint, S0_vector, &
TransMatrix, g_min_I, g_motion_ang, &
g_shape_ang, min_I_step, motion_ang_step, &
shape_ang_step, lambda_min, nb_expt_pairs, &
nb_mono_rays,nb_unit_expts,final_array_unique_pair_indices, &
l_min_I, best_l_motion_ang, best_l_shape_ang, nb_matched_pairs)
! Input/Output variables
REAL*8, INTENT(IN) :: g_min_I, g_motion_ang, g_shape_ang
REAL*8, INTENT(IN) :: min_I_step, motion_ang_step, shape_ang_step
REAL*8, INTENT(IN) :: lambda_min
INTEGER, INTENT(IN) :: nb_expt_pairs, nb_unit_expts, nb_mono_rays
REAL*8, DIMENSION(nb_unit_expts,3), INTENT(IN) :: unit_expts
REAL*8, DIMENSION(nb_unit_expts), INTENT(IN) :: unit_expts_I, unit_expts_sint
REAL*8, DIMENSION(3), INTENT(IN) :: S0_vector
REAL*8, DIMENSION(nb_mono_rays,3), INTENT(IN) :: mono_rays
REAL*8, DIMENSION(nb_mono_rays), INTENT(IN) :: mono_rays_len
REAL*8, DIMENSION(3,3), INTENT(IN) :: TransMatrix
INTEGER,DIMENSION(nb_expt_pairs,2), INTENT(OUT) :: final_array_unique_pair_indices
REAL*8, INTENT(OUT) :: l_min_I, best_l_motion_ang, best_l_shape_ang
INTEGER, INTENT(OUT) :: nb_matched_pairs
! Local variables
REAL*8 :: frame_sint_cutoff ! Cutoff sint applied on monorays
REAL*8 :: rounded_g_min_I, rounded_g_motion_ang, rounded_g_shape_ang ! Rounded limit values
REAL*8, DIMENSION(nb_unit_expts) :: sorted_unit_expts_I ! Sorted intensity array of unit vectors
REAL*8, PARAMETER :: deg2rad = 0.017453292519943295d0
INTEGER, DIMENSION(nb_unit_expts) :: unit_expts_indices
INTEGER, DIMENSION(nb_mono_rays) :: mono_rays_indices
INTEGER :: nb_motion_ang_steps, nb_shape_ang_steps
REAL*8, DIMENSION(:), ALLOCATABLE :: motion_ang_range, shape_ang_range
INTEGER, DIMENSION(:), ALLOCATABLE :: frame_mono_rays_indices
INTEGER :: I_limit_indice, nb_filtered_expts
REAL*8 :: I_limit
LOGICAL,DIMENSION(nb_unit_expts)::I_limit_mask
REAL*8, DIMENSION(:),ALLOCATABLE::filtered_unit_expts_I, filtered_unit_expts_sint
REAL*8, DIMENSION(:,:),ALLOCATABLE :: filtered_unit_expts
INTEGER,DIMENSION(:),ALLOCATABLE::filtered_unit_expts_indices
LOGICAL,DIMENSION(:), ALLOCATABLE :: frame_mono_rays_mask
REAL*8, DIMENSION(:,:), ALLOCATABLE :: frame_mono_rays
REAL*8,DIMENSION(:,:),ALLOCATABLE :: cos_delta_angles_monos_expts
LOGICAL, DIMENSION(:,:), ALLOCATABLE :: cos_delta_angles_monos_expts_mask
INTEGER, DIMENSION(:), ALLOCATABLE :: array_nb_neighbours
INTEGER, DIMENSION(:), ALLOCATABLE :: filtered_array_nb_neighbours
INTEGER :: i
! Check extremum values specified in input
rounded_g_min_I = min_I_step*FLOOR(g_min_I/min_I_step)
! Definition of crystal motion angle range
nb_motion_ang_steps = CEILING(g_motion_ang/motion_ang_step)
rounded_g_motion_ang = motion_ang_step * float(nb_motion_ang_steps)
IF (ALLOCATED(motion_ang_range)) THEN
DEALLOCATE(motion_ang_range)
END IF
ALLOCATE(motion_ang_range(nb_motion_ang_steps))
DO i = 1, nb_motion_ang_steps
motion_ang_range(i) = float(i) * motion_ang_step
END DO
! Definition of cell shape angle range
nb_shape_ang_steps = CEILING(g_shape_ang/shape_ang_step)
rounded_g_shape_ang = shape_ang_step * float(nb_shape_ang_steps)
IF (ALLOCATED(shape_ang_range)) THEN
DEALLOCATE(shape_ang_range)
END IF
ALLOCATE(shape_ang_range(nb_shape_ang_steps))
DO i = 1, nb_shape_ang_steps
shape_ang_range(i) = float(i) * shape_ang_step
END DO
! Initialisation of array of expt global indices before filtering
! Global indices of unit expts
DO i = 1, nb_unit_expts
unit_expts_indices(i) = i
END DO
! Global indices of mono rays
DO i = 1, nb_mono_rays
mono_rays_indices(i) = i
END DO
! Selection of the largest intensity unit expts
! The expected number of pairs is smaller than the number of expt vectors
IF (nb_expt_pairs .le. nb_unit_expts) THEN
! Sorting of intensity of normalized expt vectors in increasing order
sorted_unit_expts_I = unit_expts_I
call quicksort(sorted_unit_expts_I, unit_expts_indices)
I_limit_indice = nb_unit_expts - nb_expt_pairs + 1
I_limit = sorted_unit_expts_I (I_limit_indice)
! Round the intensity limit
l_min_I = dmax1(min_I_step*FLOOR(I_limit/min_I_step), rounded_g_min_I)
I_limit_mask = unit_expts_I .ge. l_min_I
ELSE
sorted_unit_expts_I = unit_expts_I
call quicksort(sorted_unit_expts_I, unit_expts_indices)
I_limit_mask = unit_expts_I .ge. rounded_g_min_I
l_min_I = rounded_g_min_I
END IF
! Selection of the first Nbexpectedpairs expts with the largest intensities
nb_filtered_expts = min(COUNT(I_limit_mask .eqv. .True.), nb_expt_pairs)
! Allocation of arrays
IF (ALLOCATED(filtered_unit_expts_I)) THEN
DEALLOCATE(filtered_unit_expts_I)
END IF
ALLOCATE(filtered_unit_expts_I(nb_filtered_expts))
IF (ALLOCATED(filtered_unit_expts_sint)) THEN
DEALLOCATE(filtered_unit_expts_sint)
END IF
IF (ALLOCATED(filtered_unit_expts_sint)) THEN
DEALLOCATE(filtered_unit_expts_sint)
END IF
ALLOCATE(filtered_unit_expts_sint(nb_filtered_expts))
IF (ALLOCATED(filtered_unit_expts_indices)) THEN
DEALLOCATE(filtered_unit_expts_indices)
END IF
ALLOCATE(filtered_unit_expts_indices(nb_filtered_expts))
IF (ALLOCATED(filtered_unit_expts)) THEN
DEALLOCATE(filtered_unit_expts)
END IF
ALLOCATE(filtered_unit_expts(nb_filtered_expts,3))
! Filtering of unit expts according to the intensity threshold
filtered_unit_expts_I = sorted_unit_expts_I (nb_unit_expts-nb_filtered_expts+1:)
filtered_unit_expts_sint = unit_expts_sint (unit_expts_indices(nb_unit_expts-nb_filtered_expts+1:))
filtered_unit_expts_indices = unit_expts_indices(nb_unit_expts-nb_filtered_expts+1:)
filtered_unit_expts = unit_expts(filtered_unit_expts_indices,:)
! If there is no expt vectors
IF (nb_filtered_expts == 0) THEN
final_array_unique_pair_indices = 0
best_l_motion_ang = 0.0
best_l_shape_ang = 0.0
nb_matched_pairs = 0
return
END IF
! Selection of mono rays
! Max sin(theta) value
frame_sint_cutoff = maxval(filtered_unit_expts_sint)
! Selection of monorays in normalized H-vector coordinate ranges by filtering
call frame_windows_filtering(mono_rays, mono_rays_len, &
TransMatrix, frame_sint_cutoff, lambda_min, S0_vector, &
rounded_g_motion_ang, frame_mono_rays_mask, frame_mono_rays)
! Deallocate memory
IF (ALLOCATED(motion_ang_range)) THEN
DEALLOCATE(motion_ang_range)
END IF
IF (ALLOCATED(shape_ang_range)) THEN
DEALLOCATE(shape_ang_range)
END IF
IF (ALLOCATED(array_nb_neighbours)) THEN
DEALLOCATE(array_nb_neighbours)
END IF
IF (ALLOCATED(filtered_array_nb_neighbours)) THEN
DEALLOCATE(filtered_array_nb_neighbours)
END IF
IF (ALLOCATED(filtered_unit_expts_I)) THEN
DEALLOCATE(filtered_unit_expts_I)
END IF
IF (ALLOCATED(filtered_unit_expts_sint)) THEN
DEALLOCATE(filtered_unit_expts_sint)
END IF
IF (ALLOCATED(filtered_unit_expts_indices)) THEN
DEALLOCATE(filtered_unit_expts_indices)
END IF
IF (ALLOCATED(filtered_unit_expts)) THEN
DEALLOCATE(filtered_unit_expts)
END IF
IF (ALLOCATED(frame_mono_rays_indices)) THEN
DEALLOCATE(frame_mono_rays_indices)
END IF
IF (ALLOCATED(cos_delta_angles_monos_expts)) THEN
DEALLOCATE(cos_delta_angles_monos_expts)
END IF
IF (ALLOCATED(cos_delta_angles_monos_expts_mask)) THEN
DEALLOCATE(cos_delta_angles_monos_expts_mask)
END IF
IF (ALLOCATED(frame_mono_rays_mask)) THEN
DEALLOCATE(frame_mono_rays_mask)
END IF
IF (ALLOCATED(frame_mono_rays)) THEN
DEALLOCATE(frame_mono_rays)
END IF
return
END SUBROUTINE matching_per_frame
! Filtering of monorays
subroutine frame_windows_filtering(mono_rays, mono_rays_len, &
TransMatrix, frame_sint_cutoff, lambda_min, S0_vector, &
motion_angle, mask, selected_transformed_mono_rays)
! Input/Output variables
REAL*8, INTENT(IN) :: frame_sint_cutoff, lambda_min
REAL*8, DIMENSION(:,:), INTENT(IN) :: mono_rays
REAL*8, DIMENSION(:), INTENT(IN) :: mono_rays_len
REAL*8, DIMENSION(3,3), INTENT(IN) :: TransMatrix
REAL*8, DIMENSION(3), INTENT(IN) :: S0_vector
REAL*8, INTENT(IN) :: motion_angle
REAL*8, DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: &
selected_transformed_mono_rays
LOGICAL,DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: mask
REAL*8:: max_h_len, Theta, cos_min, cos_max
REAL*8, DIMENSION(:,:), ALLOCATABLE :: transformed_mono_rays
REAL*8,DIMENSION(:,:),ALLOCATABLE :: &
normalized_transformed_mono_rays
REAL*8,DIMENSION(:),ALLOCATABLE :: transformed_mono_rays_normes
REAL*8, DIMENSION(:), ALLOCATABLE :: cos_angles
LOGICAL,DIMENSION(:),ALLOCATABLE :: mask_max_h_len, &
mask_max_coords, mask_min_coords
INTEGER :: mono_rays_size, i, selection_size
! Max h len max
max_h_len = 2.0 * frame_sint_cutoff/lambda_min
! Perform transformation on monorays
mono_rays_size = size(mono_rays_len)
ALLOCATE(transformed_mono_rays(mono_rays_size,3))
ALLOCATE(normalized_transformed_mono_rays(mono_rays_size,3))
ALLOCATE(transformed_mono_rays_normes(mono_rays_size))
ALLOCATE(cos_angles(mono_rays_size))
ALLOCATE(mask_max_h_len(mono_rays_size))
ALLOCATE(mask_max_coords(mono_rays_size))
ALLOCATE(mask_min_coords(mono_rays_size))
IF (ALLOCATED(mask)) THEN
DEALLOCATE(mask)
END IF
ALLOCATE(mask(mono_rays_size))
transformed_mono_rays=matmul(mono_rays,transpose(TransMatrix))
transformed_mono_rays_normes = &
sqrt(sum(transformed_mono_rays**2,2))
! Normalize transformed monorays
DO i = 1, 3
normalized_transformed_mono_rays(:,i) = &
transformed_mono_rays(:,i)/transformed_mono_rays_normes
END DO
! Cos limits
Theta = dasin(frame_sint_cutoff)
cos_max = dsin(motion_angle)
cos_min = -dsin(motion_angle+Theta)
cos_angles = MATMUL(normalized_transformed_mono_rays,S0_vector)
! Filtering of mono rays per frame considering ranges of coordinates
! Filtering of mono rays
mask_max_h_len = (mono_rays_len .le. max_h_len)
! Max coordinates filtering
mask_max_coords = (cos_angles <= cos_max)
! Min coordinates filtering
mask_min_coords = (cos_angles >= cos_min)
! Total mask
mask = mask_max_h_len.and.mask_max_coords.and.mask_min_coords
selection_size = count(mask .eqv..True.)
IF (ALLOCATED(selected_transformed_mono_rays)) THEN
DEALLOCATE(selected_transformed_mono_rays)
END IF
ALLOCATE(selected_transformed_mono_rays(selection_size,3))
! Indices of monoray vectors, normalized monoray vectors
!return mask, normalized_transformed_mono_rays(mask,:)
selected_transformed_mono_rays = RESHAPE( &
PACK(normalized_transformed_mono_rays, SPREAD(mask,2,3)), &
(/selection_size,3/))
DEALLOCATE(transformed_mono_rays)
DEALLOCATE(normalized_transformed_mono_rays)
DEALLOCATE(transformed_mono_rays_normes)
DEALLOCATE(cos_angles)
DEALLOCATE(mask_max_h_len)
DEALLOCATE(mask_max_coords)
DEALLOCATE(mask_min_coords)
end subroutine frame_windows_filtering
! quicksort: Recursive subroutine which sorts all values from a 1D-array in increasing order
recursive subroutine quicksort(Values, Indices)
REAL*8, intent(inout), dimension(:) :: Values
INTEGER, intent(inout), dimension(:) :: Indices
integer :: MarkerIndex
! If the size of A is 1, no need to sort
IF (size(Values) .gt. 1) THEN
! Partition selects a threshold value, sorts values
! to put all values smaller than this threshold before
! and to put all values larger than this threshold after
call partition(Values, Indices, MarkerIndex)
! quicksort is applied on the first part [1:IndexOfThreshold] of the array (all values smaller than the threshold)
call quicksort(Values(:MarkerIndex-1),&
Indices(:MarkerIndex-1))
! quicksort is applied on the second part [IndexOfThreshold:nbvalues] (all values larger than the threshold)
call quicksort(Values(MarkerIndex:), Indices(MarkerIndex:))
END IF
end subroutine quicksort
END MODULE Matching_Pairs
It seems you just found some Fortran code that would do what you need and you are trying to call it from Python using f2py as is.
That is not going to work. F2py only supports some basic subset of Fortran and does not support many modern ways how arguments can be passed. The subroutine you found uses allocatable dummy arguments. You cannot call it from Python using f2py. F2py simply does not support that.
If you want to call that code from Python using f2py, you will have to write a simpler Fortran subroutine, that will call that subroutine for you.
Also, you should only compile with f2py the code that you actually plan to call from Python. Other code that will only be called inside Fortran, should be compiled normally using a Fortran compiler into an ordinary object file and linked when creating the final library.