Commit 020b4397 authored by juan rodriguez-carvajal's avatar juan rodriguez-carvajal
Browse files
parents fc24e1c8 1bf7ec17
Pipeline #12143 failed with stages
in 6 minutes and 47 seconds
......@@ -242,10 +242,6 @@ Module CFML_ILL_Instrm_Data
invert => Invert_A
use CFML_Diffraction_Patterns, only: Diffraction_Pattern_Type, Allocate_Diffraction_Pattern
#ifdef USE_HDF
use HDF5
#endif
!---- Variables ----!
Implicit none
......@@ -273,9 +269,6 @@ Module CFML_ILL_Instrm_Data
Read_Calibration_File_D2B, Read_Calibration_File_D4, Adding_Numors_D1A_DiffPattern, &
Adding_Numors_D4_DiffPattern, Adding_Numors_D1B_D20, NumorD1BD20_To_DiffPattern
#ifdef USE_HDF
private:: Read_Numor_D19_NXS, Read_Nexus_D19
#endif
!---- Definitions ----!
!!----
......@@ -5006,63 +4999,6 @@ Module CFML_ILL_Instrm_Data
End Subroutine Read_Numor_D19
#ifdef USE_HDF
!!----
!!---- Subroutine Read_Numor_D19_NXS
!!----
!!---- 20/01/2021
!!
Subroutine Read_Numor_D19_NXS(filename,numor,succes,counts)
!---- Arguments ----!
character(len=*) , intent(in) :: filename
type(SXTAL_numor_type) , intent(inout) :: numor
logical :: succes
integer, optional, allocatable, dimension(:,:,:), intent(out) :: counts
!---- Local Variables ----!
character(len=512) filenamenxs
logical :: info
succes = .false.
! The error flags are initialized.
call init_err_illdata()
! Check first that the input file exists.
info=.false.
filenamenxs = filename // ".nxs"
inquire (file=filenamenxs,exist=info)
! If the input file does not exist, stop here.
if (.not. info) then
err_illdata = .true.
err_illdata_mess = " The file "//trim(filenamenxs)//" does not exist."
write (*,*) " The file " ,trim(filenamenxs)," does not exist."
succes = .false.
return
end if
! Intiliaze the numor.
call init_sxtal_numor(numor)
! If the numor to read is different from the one stored in the numor structure, reprocess the header.
if (trim(filename) /= trim(numor%filename)) then
numor%header_size=42
numor%nframes=0 ! need ?
end if
! Init NXS file Redader
! inquire (file=filenamenxs,opened=info)
!call Read_Init_NXS(filename)
!call Read_Header_NXS()
! Read NeXuS content
call Read_Nexus_D19(filenamenxs,numor,counts)
succes = .true.
End Subroutine Read_Numor_D19_NXS
#endif
!!----
!!---- Subroutine Read_Numor_Generic(filevar,N)
!!---- character(len=*), intent(in) :: fileinfo
......@@ -5622,16 +5558,8 @@ Module CFML_ILL_Instrm_Data
call Read_Numor_D16(trim(filename),num)
case ('D19','D19_HB')
#ifdef USE_HDF
call Read_Numor_D19_NXS(trim(filename),num,nxs_succes,counts)
if (.not.(nxs_succes)) then
write(*,"(a)") ' => Reading ASCII files'
call Read_Numor_D19(trim(filename),num,frames)
endif
#else
write(*,"(a)") ' => Reading ASCII files'
call Read_Numor_D19(trim(filename),num,frames)
#endif
case default
ERR_ILLData=.true.
ERR_ILLData_Mess= " Not Implemented for the SXTAL Instrument name: "//trim(instrument)
......@@ -7666,227 +7594,5 @@ Module CFML_ILL_Instrm_Data
return
End Subroutine Read_Calibration_File_D4
#ifdef USE_HDF
!!----
!!---- Subroutine Read_Nexus_D19
!!----
!!---- 20/01/2021
!!
Subroutine Read_Nexus_D19(Filename,Numor,Counts)
!---- Arguments ----!
character(len=*), intent(in) :: filename
type(SXTAL_NUMOR_type), intent(out) :: numor
integer, dimension(:,:,:), optional, allocatable, intent(out) :: counts
!---- Local variables ----!
integer :: i,j,k,i_om,i_ti,i_mo,i_mc
integer :: hdferr
integer :: inum,nfrm,nrows,ncols
real(kind=cp) :: wave,start,step,width,phi,chi,gamma,omega
real(kind=cp), dimension(9) :: ub
integer, dimension(:), allocatable :: axis
real(kind=cp), dimension(:,:), allocatable :: scan
integer, dimension(:,:,:), allocatable :: cnts
!---- Local variables with hdf5 types ----!
integer(SIZE_T), PARAMETER :: sdim = 20 ! maximum string length
integer(HID_T) :: file_id,inum_data_id,nfrm_data_id,wave_data_id,&
scan_data_id,axis_data_id,cnts_data_id,&
start_data_id,step_data_id,width_data_id,&
ub_data_id,nrows_data_id,ncols_data_id,&
phi_data_id,chi_data_id,gamma_data_id,&
omega_data_id,name_data_id,memtype,filetype
integer(HID_T) :: axis_space_id,scan_space_id,cnts_space_id,name_space_id
integer(HSIZE_T), dimension(1) :: scalar,axis_dim,axis_maxdim,&
ub_dim,ub_maxdim,name_dim,name_maxdim
integer(HSIZE_T), dimension(2) :: scan_dims,scan_maxdims
integer(HSIZE_T), dimension(3) :: cnts_dims,cnts_maxdims
character(len=sdim), dimension(:), allocatable :: name_
integer(HSIZE_T), dimension(2) :: name_dims
integer(SIZE_T), dimension(:), allocatable :: str_len
!---- Initialize variables
ub_dim(1) = 9
ub_maxdim(1) = 9
if (allocated(cnts)) deallocate(cnts)
!---- Initialize fortran interface
call h5open_f(hdferr)
!---- Open NEXUS file
write(*,'(2A)') " => Opening Nexus file ",trim(filename)
write(*,'(A)') " Reading data..."
call h5fopen_f(trim(filename),H5F_ACC_RdoNLY_F,file_id,hdferr)
!---- Open datasets
call h5dopen_f(file_id,'entry0/run_number',inum_data_id,hdferr)
call h5dopen_f(file_id,'entry0/data_scan/actual_step',nfrm_data_id,hdferr)
call h5dopen_f(file_id,'entry0/wavelength',wave_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/ScanInfo/first_start_value',start_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/ScanInfo/first_step_value',step_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/ScanInfo/first_width_value',width_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/SingleCrystalSettings/orientation_matrix',ub_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/Det1/nrows',nrows_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/Det1/ncols',ncols_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/gamma/value',gamma_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/chi/value',chi_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/phi/value',phi_data_id,hdferr)
call h5dopen_f(file_id,'entry0/instrument/omega/value',omega_data_id,hdferr)
call h5dopen_f(file_id,'entry0/data_scan/scanned_variables/variables_names/axis',axis_data_id,hdferr)
call h5dopen_f(file_id,'entry0/data_scan/scanned_variables/variables_names/name',name_data_id,hdferr)
call h5dopen_f(file_id,'entry0/data_scan/scanned_variables/data',scan_data_id,hdferr)
call h5dopen_f(file_id,'entry0/data_scan/detector_data/data',cnts_data_id,hdferr)
!---- Get type of string datasets
call h5dget_type_f(name_data_id, filetype, hdferr)
!---- Get dimensions of datasets
call h5dget_space_f(axis_data_id,axis_space_id,hdferr)
call h5dget_space_f(name_data_id,name_space_id,hdferr)
call h5dget_space_f(scan_data_id,scan_space_id,hdferr)
call h5dget_space_f(cnts_data_id,cnts_space_id,hdferr)
call h5sget_simple_extent_dims_f(axis_space_id,axis_dim,axis_maxdim,hdferr)
call h5sget_simple_extent_dims_f(name_space_id,name_dim,name_maxdim,hdferr)
call h5sget_simple_extent_dims_f(scan_space_id,scan_dims,scan_maxdims,hdferr)
call h5sget_simple_extent_dims_f(cnts_space_id,cnts_dims,cnts_maxdims,hdferr)
!---- Assign memory to arrays
allocate(axis(axis_dim(1)))
allocate(name_(name_dim(1)))
allocate(scan(scan_dims(1),scan_dims(2)))
allocate(cnts(cnts_dims(1),cnts_dims(2),cnts_dims(3)))
allocate(str_len(name_dim(1)))
str_len(:) = sdim
name_dims(:) = (/ sdim, name_dim(1) /)
!---- Read datasets
call h5dread_f(inum_data_id,H5T_NATIVE_INTEGER,inum,scalar,hdferr)
call h5dread_f(nfrm_data_id,H5T_NATIVE_INTEGER,nfrm,scalar,hdferr)
call h5dread_f(wave_data_id,H5T_NATIVE_REAL,wave,scalar,hdferr)
call h5dread_f(start_data_id,H5T_NATIVE_REAL,start,scalar,hdferr)
call h5dread_f(step_data_id,H5T_NATIVE_REAL,step,scalar,hdferr)
call h5dread_f(width_data_id,H5T_NATIVE_REAL,width,scalar,hdferr)
call h5dread_f(ub_data_id,H5T_NATIVE_REAL,ub,ub_dim,hdferr)
call h5dread_f(gamma_data_id,H5T_NATIVE_REAL,gamma,scalar,hdferr)
call h5dread_f(chi_data_id,H5T_NATIVE_REAL,chi,scalar,hdferr)
call h5dread_f(phi_data_id,H5T_NATIVE_REAL,phi,scalar,hdferr)
call h5dread_f(omega_data_id,H5T_NATIVE_REAL,omega,scalar,hdferr)
call h5dread_f(nrows_data_id,H5T_NATIVE_INTEGER,nrows,scalar,hdferr)
call h5dread_f(ncols_data_id,H5T_NATIVE_INTEGER,ncols,scalar,hdferr)
call h5dread_f(axis_data_id,H5T_NATIVE_INTEGER,axis,axis_dim,hdferr)
call h5dread_f(scan_data_id,H5T_NATIVE_REAL,scan,scan_dims,hdferr)
call h5dread_f(cnts_data_id,H5T_NATIVE_INTEGER,cnts,cnts_dims,hdferr)
!---- Read keywords of the data scan
call h5dread_vl_f(name_data_id,filetype,name_,name_dims,str_len,hdferr,name_space_id)
!---- Find keywords
i_om = -1
i_ti = -1
i_mo = -1
i_mc = -1
do i = 1 , scan_dims(2)
select case(l_case(trim(name_(i))))
case("omega")
i_om = i
case("acquisitionspy") ! time
i_ti = i
case("monitor1")
i_mo = i
case("multicalib") ! total counts
i_mc = i
end select
end do
if (i_om == -1) then
err_ILLData = .true.
err_ILLData_mess = "Error reading numor. Omega not found in scanned variables"
return
end if
!---- Close datasets
call h5dclose_f(inum_data_id,hdferr)
call h5dclose_f(nfrm_data_id,hdferr)
call h5dclose_f(wave_data_id,hdferr)
call h5dclose_f(start_data_id,hdferr)
call h5dclose_f(step_data_id,hdferr)
call h5dclose_f(width_data_id,hdferr)
call h5dclose_f(ub_data_id,hdferr)
call h5dclose_f(nrows_data_id,hdferr)
call h5dclose_f(ncols_data_id,hdferr)
call h5dclose_f(axis_data_id,hdferr)
call h5dclose_f(name_data_id,hdferr)
call h5dclose_f(scan_data_id,hdferr)
call h5dclose_f(cnts_data_id,hdferr)
call h5dclose_f(gamma_data_id,hdferr)
call h5dclose_f(chi_data_id,hdferr)
call h5dclose_f(phi_data_id,hdferr)
call h5dclose_f(omega_data_id,hdferr)
!---- Close NEXUS file.
write(*,'(2A)') " Closing Nexus file ",trim(filename)
call h5fclose_f(file_id,hdferr)
!---- Close FORTRAN interface.
call h5close_f(hdferr)
!---- Build the Numor object
! Only omega scans can be processed for the moment.
! Raise an error otherwise
write(*,'(A)') " => Building Numor..."
call Initialize_Numor(numor)
numor%numor = inum
numor%instrm = 'D19'
numor%scantype = 'omega'
numor%manip = 2
numor%nbang = 1
numor%wave = wave
numor%nframes = nfrm
numor%nbdata = nrows * ncols
numor%angles(1) = phi
numor%angles(2) = chi
numor%angles(3) = omega
numor%angles(4) = gamma
numor%scans(:) = (/ start,step,width /)
numor%ub = transpose(RESHAPE(ub,[3,3]))
allocate(numor%tmc_ang(numor%nbang+3,numor%nframes))
if (i_ti == -1) then
write(*,'(2a)') " => WARNING: time (acquisitionspy) not found",&
" in scanned variables..."
numor%tmc_ang(1,:) = 0
else
numor%tmc_ang(1,:) = scan(:,i_ti)
end if
if (i_mo == -1) then
write(*,'(2a)') " => WARNING: monitor (monitor1) not found",&
" in scanned variables..."
numor%tmc_ang(2,:) = 0
else
numor%tmc_ang(2,:) = scan(:,i_mo)
end if
if (i_mc == -1) then
write(*,'(2a)') " => WARNING: total counts (multicalib)",&
" not found in scanned variables..."
numor%tmc_ang(3,:) = 0
else
numor%tmc_ang(3,:) = scan(:,i_mc)
end if
numor%tmc_ang(4,:) = scan(:,i_om) ! angle
if (PRESENT(counts)) then
allocate(counts(nrows,ncols,nfrm))
do k = 1 , nfrm
do j = 1 , ncols
do i = 1 , nrows
counts(i,j,k) = cnts(nrows-i+1,j,k) ! Flip
end do
end do
end do
end if
deallocate(cnts)
End Subroutine Read_Nexus_D19
#endif
End Module CFML_ILL_Instrm_Data
......@@ -31,7 +31,7 @@ macro(set_compiler_flags)
set(OPT_FLAGS2 "/O1 /Qparallel")
set(OPT_FLAGS3 "/O3 /Qparallel")
else()
set(OPT_FLAGS0 "/Od")
set(OPT_FLAGS0 "/Od")
set(OPT_FLAGS "/O2")
set(OPT_FLAGS1 "/Od")
set(OPT_FLAGS2 "/O1")
......@@ -44,6 +44,7 @@ macro(set_compiler_flags)
set(OPT_FLAGS "-g")
set(OPT_FLAGS1 "-g")
set(OPT_FLAGS0 "-O0")
set(OPT_FLAGS2 "-O1")
elseif(CMAKE_BUILD_TYPE STREQUAL Release)
set(CMAKE_Fortran_FLAGS_RELEASE "-warn -cpp -qopt-report=0 -fPIC")
set(OPT_FLAGS0 "-O0")
......@@ -57,6 +58,7 @@ macro(set_compiler_flags)
set(OPT_FLAGS "-g")
set(OPT_FLAGS1 "-g")
set(OPT_FLAGS0 "-O0")
set(OPT_FLAGS2 "-O1")
elseif(CMAKE_BUILD_TYPE STREQUAL Release)
set(CMAKE_Fortran_FLAGS_RELEASE "-warn -cpp -qopt-report=0 -fPIC")
set(OPT_FLAGS0 "-O0")
......@@ -125,11 +127,13 @@ macro(set_compiler_flags)
set(OPT_FLAGS "-g")
set(OPT_FLAGS1 "-g")
set(OPT_FLAGS0 "-g")
set(OPT_FLAGS2 "-g")
elseif(CMAKE_BUILD_TYPE STREQUAL Release)
set(CMAKE_Fortran_FLAGS_RELEASE "-cpp -ffree-line-length-none -fPIC")
set(OPT_FLAGS "-O3")
set(OPT_FLAGS1 "-O0")
set(OPT_FLAGS0 "-O0")
set(OPT_FLAGS2 "-O1")
endif()
else()
if(CMAKE_BUILD_TYPE STREQUAL Debug)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment