diff --git a/NamelistTemplates/EM4DEBSD.template b/NamelistTemplates/EM4DEBSD.template index dc0e388..aab3543 100644 --- a/NamelistTemplates/EM4DEBSD.template +++ b/NamelistTemplates/EM4DEBSD.template @@ -19,7 +19,7 @@ !===================================== ! if doconvolution = .TRUE., then perform a full data set convolution and store the ! results in the HDF5 file convolvedpatternfile [relative to EMdatapathname] -! else we do one mask at a time +! else we interrogate the convolvedpatternfile !===================================== doconvolution = .FALSE., convolvedpatternfile = 'undefined', @@ -44,7 +44,7 @@ ! square virtual detector size (should be odd numbers of the form 2*n+1 !) VDsize = 5, ! Gaussian virtual detector standard deviation - VDSD = 0.5, + VDSD = 2.5, ! Hann window alpha parameter VDHannAlpha = 0.5, ! stepsize in pixels for VDtype='Array' mode diff --git a/Source/EMsoftOOLib/mod_filters.f90 b/Source/EMsoftOOLib/mod_filters.f90 index 9a26ddb..8723a0d 100644 --- a/Source/EMsoftOOLib/mod_filters.f90 +++ b/Source/EMsoftOOLib/mod_filters.f90 @@ -1311,6 +1311,38 @@ recursive subroutine HannWindow(roi_size, window, alpha) end subroutine HannWindow +!-------------------------------------------------------------------------- +recursive subroutine GaussianWindow(roi_size, window, SD) +!DEC$ ATTRIBUTES DLLEXPORT :: GaussianWindow +! +!> @brief Gaussian windowing function for pattern region of interest +! +!> @date 04/21/24 MDG 1.0 original +!-------------------------------------------------------------------------- + +IMPLICIT NONE + +integer(kind=irg),INTENT(IN) :: roi_size +real(kind=dbl),INTENT(INOUT) :: window(roi_size, roi_size) +real(kind=dbl),INTENT(IN) :: SD + +integer(kind=irg) :: i, j, r +real(kind=dbl) :: h, k, x, y + +r = (roi_size-1)/2 +window = 0.D0 +h = 1.D0/(2.D0*cPi*SD) +k = 1.D0/(2.D0*SD) +do i=-r,r + x = dble(i)**2 + do j=-r,r + y = dble(j)**2 + window(i+r+1,j+r+1) = h * exp( -k*(x+y)) + end do +end do + +end subroutine GaussianWindow + !-------------------------------------------------------------------------- recursive subroutine init_BandPassFilter(dims, high_pass, low_pass, hpmask_shifted, & lpmask_shifted, inp, outp, planf, planb) diff --git a/Source/EMsoftOOLib/program_mods/mod_4DEBSD.f90 b/Source/EMsoftOOLib/program_mods/mod_4DEBSD.f90 index b5390c1..8591b42 100644 --- a/Source/EMsoftOOLib/program_mods/mod_4DEBSD.f90 +++ b/Source/EMsoftOOLib/program_mods/mod_4DEBSD.f90 @@ -344,11 +344,10 @@ subroutine readNameList_(self, nmlfile, initonly) end if end if - if (trim(VDtype).eq.'Array') then - if (trim(convolvedpatternfile).eq.'undefined') then - call Message%printError('readNameList:',' convolvedpatternfile file name is undefined in '//nmlfile) - end if + if (trim(convolvedpatternfile).eq.'undefined') then + call Message%printError('readNameList:',' convolvedpatternfile file name is undefined in '//nmlfile) end if + end if self%nml%ipf_ht = ipf_ht @@ -1460,7 +1459,7 @@ subroutine drawMPpositions_(self, n, ctmp, sz, MP) integer(int8) :: i8 (3,4) integer(int8), allocatable :: TIFF_image(:,:) -TIFF_filename = 'Debug_MPpositions.tiff' +TIFF_filename = 'MPpositions.tiff' allocate(TIFF_image(sz(1),sz(2))) npx = (sz(1)-1)/2 w = 2 @@ -1532,7 +1531,7 @@ subroutine drawEBSPpositions_(self, sz, pat) integer(int8) :: i8 (3,4) integer(int8), allocatable :: TIFF_image(:,:) -TIFF_filename = 'Debug_EBSPpositions.tiff' +TIFF_filename = 'EBSPpositions.tiff' allocate(TIFF_image(sz(1),sz(2))) ! and generate the tiff output file @@ -1807,11 +1806,15 @@ subroutine EBSD4D_(self, EMsoft, progname, HDFnames) select case(nml%VDtype) case('Flat') VDmask = 1.0 + case('Gaus') + call GaussianWindow(nml%VDsize, VDmaskd, dble(nml%VDSD)) + VDmask = sngl(VDmaskd) + call mem%dealloc(VDmaskd, 'VDmaskd') case('Hann') call HannWindow(nml%VDsize, VDmaskd, dble(nml%VDHannAlpha)) VDmask = sngl(VDmaskd) call mem%dealloc(VDmaskd, 'VDmaskd') - case('Array') + case('Array') ! we don't need this option, but it should be here so we don't default out VDmask = 1.0 case default @@ -1861,7 +1864,7 @@ subroutine EBSD4D_(self, EMsoft, progname, HDFnames) c = LL * ca d = LL*LL mv_plane = plane(a,b,c,d) - call mv_plane%log(' Detector plane ') + call mv_plane%log(' Detector plane multivector ') dl = DIFT%nml%delta ! for each sampling point, transform all numhatn vectors to the sample frame using the ! corresponding orientation quaternion from the qAR list; then determine where those @@ -1932,6 +1935,7 @@ subroutine EBSD4D_(self, EMsoft, progname, HDFnames) quat = conjg(quat) newctmp = quat%quat_Lp_vecarray(numhatn, transpose(ctmp)) ! do kk=1,numhatn +! we will take the same symmetrically equivalent representative as selected above mv_line = line(newctmp(1,VDkk),newctmp(2,VDkk),newctmp(3,VDkk)) mv_line = mv_line%normalized() mv = meet(mv_plane, mv_line)