reworked python - fortran interfacing
This commit is contained in:
Krishna Komerla
parent
b17740c9c3
commit
d638c563af
|
|
@ -1,40 +0,0 @@
|
|||
! Copyright 2012 Max-Planck-Institut für Eisenforschung GmbH
|
||||
!
|
||||
! This file is part of DAMASK,
|
||||
! the Düsseldorf Advanced Material Simulation Kit.
|
||||
!
|
||||
! DAMASK 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 3 of the License, or
|
||||
! (at your option) any later version.
|
||||
!
|
||||
! DAMASK 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 DAMASK. If not, see <http://www.gnu.org/licenses/>.
|
||||
!
|
||||
!##################################################################################################
|
||||
!* $Id$
|
||||
!##################################################################################################
|
||||
|
||||
!********************************************************************
|
||||
! quit subroutine to satisfy IO_error
|
||||
!
|
||||
!********************************************************************
|
||||
subroutine quit(stop_id)
|
||||
use prec, only: &
|
||||
pInt
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: stop_id
|
||||
|
||||
if (stop_id == 0_pInt) stop 0 ! normal termination
|
||||
if (stop_id <= 9000_pInt) then ! trigger regridding
|
||||
write(6,'(i4)') stop_id
|
||||
stop 1
|
||||
endif
|
||||
stop 'abnormal termination of DAMASK_spectral'
|
||||
end subroutine
|
||||
|
|
@ -38,7 +38,7 @@ module DAMASK_interface
|
|||
getLoadCase, &
|
||||
getLoadCaseName, &
|
||||
getModelName, &
|
||||
DAMASK_interface_init
|
||||
DAMASK_interface_init
|
||||
private :: rectifyPath, &
|
||||
makeRelativePath, &
|
||||
getPathSep
|
||||
|
|
@ -49,117 +49,22 @@ contains
|
|||
!> @brief initializes the solver by interpreting the command line arguments. Also writes
|
||||
!! information on computation on screen
|
||||
!--------------------------------------------------------------------------------------------------
|
||||
subroutine DAMASK_interface_init
|
||||
|
||||
subroutine DAMASK_interface_init(loadcaseParameterIn,geometryParameterIn)
|
||||
use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment)
|
||||
use prec, only: pInt
|
||||
|
||||
implicit none
|
||||
character(len=1024) :: commandLine, & !< command line call as string
|
||||
hostName, & !< name of computer
|
||||
character(len=1024) :: hostName, & !< name of computer
|
||||
userName !< name of user calling the executable
|
||||
integer :: i, &
|
||||
start ,&
|
||||
length
|
||||
character(len=1024), intent(in) :: loadcaseParameterIn
|
||||
character(len=1024), intent(in) :: geometryParameterIn
|
||||
integer, dimension(8) :: dateAndTime ! type default integer
|
||||
|
||||
call get_command(commandLine)
|
||||
geometryParameter = loadcaseParameterIn
|
||||
loadcaseParameter = geometryParameterIn
|
||||
|
||||
call date_and_time(values = dateAndTime)
|
||||
do i = 1,len(commandLine) ! remove capitals
|
||||
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) &
|
||||
commandLine(i:i) = achar(iachar(commandLine(i:i))+32)
|
||||
enddo
|
||||
|
||||
if(index(commandLine,' -h ',.true.) > 0 .or. index(commandLine,' --help ',.true.) > 0) then ! search for ' -h ' or '--help'
|
||||
write(6,'(a)') '$Id$'
|
||||
#include "compilation_info.f90"
|
||||
write(6,'(a)') '#############################################################'
|
||||
write(6,'(a)') 'DAMASK spectral:'
|
||||
write(6,'(a)') 'The spectral method boundary value problem solver for'
|
||||
write(6,'(a)') 'the Duesseldorf Advanced Material Simulation Kit'
|
||||
write(6,'(a)') '#############################################################'
|
||||
write(6,'(a)') 'Valid command line switches:'
|
||||
write(6,'(a)') ' --geom (-g, --geometry)'
|
||||
write(6,'(a)') ' --load (-l, --loadcase)'
|
||||
write(6,'(a)') ' --restart (-r)'
|
||||
write(6,'(a)') ' --help (-h)'
|
||||
write(6,'(a)') ' '
|
||||
write(6,'(a)') 'Mandatory Arguments:'
|
||||
write(6,'(a)') ' --load PathToLoadFile/NameOfLoadFile.load'
|
||||
write(6,'(a)') ' "PathToGeomFile" will be the working directory.'
|
||||
write(6,'(a)') ' Make sure the file "material.config" exists in the working'
|
||||
write(6,'(a)') ' directory'
|
||||
write(6,'(a)') ' For further configuration place "numerics.config"'
|
||||
write(6,'(a)') ' and "numerics.config" in that directory.'
|
||||
write(6,'(a)') ' '
|
||||
write(6,'(a)') ' --geom PathToGeomFile/NameOfGeom.geom'
|
||||
write(6,'(a)') ' '
|
||||
write(6,'(a)') 'Optional Argument:'
|
||||
write(6,'(a)') ' --restart XX'
|
||||
write(6,'(a)') ' Reads in total increment No. XX-1 and continous to'
|
||||
write(6,'(a)') ' calculate total increment No. XX.'
|
||||
write(6,'(a)') ' Attention: Overwrites existing results file '
|
||||
write(6,'(a)') ' "NameOfGeom_NameOfLoadFile_spectralOut".'
|
||||
write(6,'(a)') ' Works only if the restart information for total increment'
|
||||
write(6,'(a)') ' No. XX-1 is available in the working directory.'
|
||||
write(6,'(a)') 'Help:'
|
||||
write(6,'(a)') ' --help'
|
||||
write(6,'(a)') ' Prints this message and exits'
|
||||
write(6,'(a)') ' '
|
||||
call quit(0_pInt)
|
||||
endif
|
||||
if (.not.(command_argument_count()==4 .or. command_argument_count()==6)) & ! check for correct number of given arguments (no --help)
|
||||
stop 'Wrong Nr. of Arguments. Run DAMASK_spectral.exe --help' ! Could not find valid keyword (position 0 +3). Functions from IO.f90 are not available
|
||||
start = index(commandLine,'-g',.true.) + 3 ! search for '-g' and jump to first char of geometry
|
||||
if (index(commandLine,'--geom',.true.)>0) then ! if '--geom' is found, use that (contains '-g')
|
||||
start = index(commandLine,'--geom',.true.) + 7
|
||||
endif
|
||||
if (index(commandLine,'--geometry',.true.)>0) then ! again, now searching for --geometry'
|
||||
start = index(commandLine,'--geometry',.true.) + 11
|
||||
endif
|
||||
if(start==3_pInt) then ! Could not find valid keyword (position 0 +3). Functions from IO.f90 are not available
|
||||
write(6,'(a)') 'No Geometry specified'
|
||||
call quit(9999)
|
||||
endif
|
||||
length = index(commandLine(start:len(commandLine)),' ',.false.)
|
||||
|
||||
call get_command(commandLine) ! may contain capitals
|
||||
geometryParameter = '' ! should be empty
|
||||
geometryParameter(1:length)=commandLine(start:start+length)
|
||||
|
||||
do i=1,len(commandLine) ! remove capitals
|
||||
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) commandLine(i:i)&
|
||||
= achar(iachar(commandLine(i:i))+32)
|
||||
enddo
|
||||
|
||||
start = index(commandLine,'-l',.true.) + 3 ! search for '-l' and jump forward iby 3 to given name
|
||||
if (index(commandLine,'--load',.true.)>0) then ! if '--load' is found, use that (contains '-l')
|
||||
start = index(commandLine,'--load',.true.) + 7
|
||||
endif
|
||||
if (index(commandLine,'--loadcase',.true.)>0) then ! again, now searching for --loadcase'
|
||||
start = index(commandLine,'--loadcase',.true.) + 11
|
||||
endif
|
||||
if(start==3_pInt) then ! Could not find valid keyword (position 0 +3). Functions from IO.f90 are not available
|
||||
write(6,'(a)') 'No Loadcase specified'
|
||||
call quit(9999)
|
||||
endif
|
||||
length = index(commandLine(start:len(commandLine)),' ',.false.)
|
||||
|
||||
call get_command(commandLine) ! may contain capitals
|
||||
loadcaseParameter = '' ! should be empty
|
||||
loadcaseParameter(1:length)=commandLine(start:start+length)
|
||||
|
||||
do i=1,len(commandLine) ! remove capitals
|
||||
if(64<iachar(commandLine(i:i)) .and. iachar(commandLine(i:i))<91) commandLine(i:i)&
|
||||
= achar(iachar(commandLine(i:i))+32)
|
||||
enddo
|
||||
|
||||
start = index(commandLine,'-r',.true.) + 3 ! search for '-r' and jump forward iby 3 to given name
|
||||
if (index(commandLine,'--restart',.true.)>0) then ! if '--restart' is found, use that (contains '-l')
|
||||
start = index(commandLine,'--restart',.true.) + 7
|
||||
endif
|
||||
length = index(commandLine(start:len(commandLine)),' ',.false.)
|
||||
|
||||
call get_command(commandLine) ! may contain capitals
|
||||
call GET_ENVIRONMENT_VARIABLE('HOST',hostName)
|
||||
call GET_ENVIRONMENT_VARIABLE('USER',userName)
|
||||
|
||||
|
|
@ -176,10 +81,8 @@ subroutine DAMASK_interface_init
|
|||
write(6,*) 'Host Name: ', trim(hostName)
|
||||
write(6,*) 'User Name: ', trim(userName)
|
||||
write(6,*) 'Path Separator: ', getPathSep()
|
||||
write(6,*) 'Command line call: ', trim(commandLine)
|
||||
write(6,*) 'Geometry Parameter: ', trim(geometryParameter)
|
||||
write(6,*) 'Loadcase Parameter: ', trim(loadcaseParameter)
|
||||
if (start/=3_pInt) write(6,*) 'Restart Parameter: ', trim(commandLine(start:start+length))
|
||||
|
||||
end subroutine DAMASK_interface_init
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,63 @@
|
|||
! Copyright 2011 Max-Planck-Institut für Eisenforschung GmbH
|
||||
!
|
||||
! This file is part of DAMASK,
|
||||
! the Düsseldorf Advanced MAterial Simulation Kit.
|
||||
!
|
||||
! DAMASK 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 3 of the License, or
|
||||
! (at your option) any later version.
|
||||
!
|
||||
! DAMASK 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 DAMASK. If not, see <http://www.gnu.org/licenses/>.
|
||||
!
|
||||
!##################################################################################################
|
||||
!* $Id: DAMASK_spectral_AL.f90 1425 2012-04-06 14:23:06Z MPIE\m.diehl $
|
||||
!##################################################################################################
|
||||
! Material subroutine for BVP solution using spectral method
|
||||
!
|
||||
! Run 'DAMASK_spectral.exe --help' to get usage hints
|
||||
!
|
||||
! written by P. Eisenlohr,
|
||||
! F. Roters,
|
||||
! L. Hantcherli,
|
||||
! W.A. Counts,
|
||||
! D.D. Tjahjanto,
|
||||
! C. Kords,
|
||||
! M. Diehl,
|
||||
! R. Lebensohn
|
||||
!
|
||||
! MPI fuer Eisenforschung, Duesseldorf
|
||||
!********************************************************************
|
||||
! quit subroutine to satisfy IO_error
|
||||
!
|
||||
!********************************************************************
|
||||
subroutine quit(stop_id)
|
||||
use prec, only: &
|
||||
pInt
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: stop_id
|
||||
integer, dimension(8) :: dateAndTime ! type default integer
|
||||
|
||||
call date_and_time(values = dateAndTime)
|
||||
write(6,'(/,a)') 'Terminated on:'
|
||||
write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',&
|
||||
dateAndTime(2),'/',&
|
||||
dateAndTime(1)
|
||||
write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',&
|
||||
dateAndTime(6),':',&
|
||||
dateAndTime(7)
|
||||
write(6,'(/,a)') 'Exit code:'
|
||||
if (stop_id == 1_pInt) stop 1 ! normal termination
|
||||
if (stop_id <= 0_pInt) then ! trigger regridding
|
||||
write(6,'(a,i6)') 'restart a', stop_id*(-1_pInt)
|
||||
stop 2
|
||||
endif
|
||||
stop 0 ! error
|
||||
end subroutine
|
||||
|
|
@ -1127,21 +1127,4 @@ C_ref = C * wgt
|
|||
call quit(0_pInt)
|
||||
end program DAMASK_spectral
|
||||
|
||||
!********************************************************************
|
||||
! quit subroutine to satisfy IO_error
|
||||
!
|
||||
!********************************************************************
|
||||
subroutine quit(stop_id)
|
||||
use prec, only: &
|
||||
pInt
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: stop_id
|
||||
|
||||
if (stop_id == 0_pInt) stop 0 ! normal termination
|
||||
if (stop_id <= 9000_pInt) then ! trigger regridding
|
||||
write(6,'(i4)') stop_id
|
||||
stop 1
|
||||
endif
|
||||
stop 'abnormal termination of DAMASK_spectral'
|
||||
end subroutine
|
||||
#include "DAMASK_quit.f90"
|
||||
|
|
@ -929,31 +929,4 @@ program DAMASK_spectral_AL
|
|||
call quit(1_pInt)
|
||||
end program DAMASK_spectral_AL
|
||||
|
||||
!********************************************************************
|
||||
! quit subroutine to satisfy IO_error
|
||||
!
|
||||
!********************************************************************
|
||||
subroutine quit(stop_id)
|
||||
use prec, only: &
|
||||
pInt
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: stop_id
|
||||
integer, dimension(8) :: dateAndTime ! type default integer
|
||||
|
||||
call date_and_time(values = dateAndTime)
|
||||
write(6,'(/,a)') 'DAMASK_spectral_AL terminated on:'
|
||||
write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',&
|
||||
dateAndTime(2),'/',&
|
||||
dateAndTime(1)
|
||||
write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',&
|
||||
dateAndTime(6),':',&
|
||||
dateAndTime(7)
|
||||
write(6,'(/,a)') 'Exit code:'
|
||||
if (stop_id == 1_pInt) stop 1 ! normal termination
|
||||
if (stop_id <= 0_pInt) then ! trigger regridding
|
||||
write(6,'(a,i6)') 'restart a', stop_id*(-1_pInt)
|
||||
stop 2
|
||||
endif
|
||||
stop 0 ! error
|
||||
end subroutine
|
||||
#include "DAMASK_quit.f90"
|
||||
|
|
@ -1,80 +0,0 @@
|
|||
! Copyright 2011,2012 Max-Planck-Institut für Eisenforschung GmbH
|
||||
!
|
||||
! This file is part of DAMASK,
|
||||
! the Düsseldorf Advanced MAterial Simulation Kit.
|
||||
!
|
||||
! DAMASK 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 3 of the License, or
|
||||
! (at your option) any later version.
|
||||
!
|
||||
! DAMASK 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 DAMASK. If not, see <http://www.gnu.org/licenses/>.
|
||||
!
|
||||
!##############################################################
|
||||
!* $Id$
|
||||
!##############################################################
|
||||
|
||||
module prec
|
||||
|
||||
implicit none
|
||||
! *** Precision of real and integer variables for python interfacing***
|
||||
integer, parameter :: pReal = 8
|
||||
integer, parameter :: pInt = 4
|
||||
real(pReal), parameter :: DAMASK_NaN = real(Z'7FF0000000000001',pReal)
|
||||
real(pReal), parameter :: tol_math_check = 1.0e-8_pReal
|
||||
|
||||
end module prec
|
||||
|
||||
|
||||
module debug
|
||||
|
||||
use prec, only: pInt
|
||||
|
||||
implicit none
|
||||
integer(pInt), parameter, public :: &
|
||||
debug_levelBasic = 2_pInt**1_pInt, &
|
||||
debug_math = 2_pInt
|
||||
integer(pInt), dimension(11+2), public :: &
|
||||
debug_what = debug_levelBasic
|
||||
|
||||
end module debug
|
||||
|
||||
|
||||
module numerics
|
||||
|
||||
use prec, only: pInt, pReal
|
||||
|
||||
implicit none
|
||||
real(pReal), parameter :: fftw_timelimit = -1.0_pReal
|
||||
integer(pInt), parameter :: fftw_planner_flag = 32_pInt
|
||||
integer(pInt), parameter :: fixedSeed = 1_pInt
|
||||
|
||||
end module numerics
|
||||
|
||||
|
||||
module IO
|
||||
contains
|
||||
|
||||
subroutine IO_error(error_ID,e,i,g,ext_msg)
|
||||
|
||||
use prec, only: pInt
|
||||
|
||||
implicit none
|
||||
integer(pInt), intent(in) :: error_ID
|
||||
integer(pInt), optional, intent(in) :: e,i,g
|
||||
character(len=*), optional, intent(in) :: ext_msg
|
||||
character(len=1024) msg
|
||||
|
||||
select case (error_ID)
|
||||
case default
|
||||
print*, 'Error messages not supported when interfacing to Python'
|
||||
end select
|
||||
end subroutine IO_error
|
||||
|
||||
end module IO
|
||||
|
|
@ -13,6 +13,20 @@
|
|||
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
python module core ! in
|
||||
interface ! in :core
|
||||
|
||||
module damask_interface ! in :damask_interface:DAMASK_python_interface.f90
|
||||
|
||||
function getSolverWorkingDirectoryName()
|
||||
character(len=1024) :: getSolverWorkingDirectoryName()
|
||||
end function getSolverWorkingDirectoryName
|
||||
|
||||
subroutine damask_interface_init(loadcaseParameterIn,geometryParameterIn) ! in :damask_interface:DAMASK_python_interface.f90
|
||||
character(len=1024), intent(in) :: loadcaseParameterIn
|
||||
character(len=1024), intent(in) :: geometryParameterIn
|
||||
end subroutine damask_interface_init
|
||||
|
||||
end module damask_interface
|
||||
|
||||
module math ! in :math:math.f90
|
||||
|
||||
subroutine volume_compare(res,geomdim,defgrad,nodes,volume_mismatch) ! in :math:math.f90
|
||||
|
|
@ -147,6 +161,18 @@ python module core ! in
|
|||
! output variables
|
||||
real*8, dimension(res[0],res[1],res[2]),intent(out),depend(res[0],res[1],res[2]) :: vm
|
||||
end subroutine math_equivStrain33_field
|
||||
|
||||
subroutine math_nearestNeighborSearch(res_new,Npoints_old,defgrad_av,geomdim,spatial_dim,deformed_set,result_indices) ! in :math:math.f90
|
||||
! input variables
|
||||
integer, dimension(3), intent(in) :: res_new
|
||||
integer, intent(in) :: Npoints_old
|
||||
integer, intent(in) :: spatial_dim
|
||||
real, dimension(3), intent(in) :: geomdim
|
||||
real, dimension(3,3), intent(in) :: defgrad_av
|
||||
real, dimension(spatial_dim,Npoints_old), intent(in),depend(spatial_dim,Npoints_old) :: deformed_set
|
||||
! output variables
|
||||
integer, dimension(res_new[0]*res_new[1]*res_new[2]), intent(out),depend(res_new[0],res_new[1],res_new[2]) :: result_indices
|
||||
end subroutine math_nearestNeighborSearch
|
||||
end module math
|
||||
end interface
|
||||
end python module core
|
||||
|
|
|
|||
|
|
@ -3820,43 +3820,46 @@ end subroutine calculate_cauchy
|
|||
!############################################################################
|
||||
! subroutine to find nearest_neighbor.
|
||||
!############################################################################
|
||||
|
||||
subroutine find_nearest_neighbor(res,geomdim,defgrad_av,spatial_dim,range_dim,domain_dim,&
|
||||
range_set,domain_set, map_range_to_domain)
|
||||
subroutine math_nearestNeighborSearch(res_new, Npoints_old, defgrad_av, geomdim, &
|
||||
spatial_dim, deformed_set, result_indices)
|
||||
use kdtree2_module
|
||||
real(pReal), dimension(3), intent(in) :: geomdim
|
||||
real(pReal), dimension(3,3), intent(in) :: defgrad_av
|
||||
integer(pInt), dimension(3), intent(in) :: res
|
||||
real(pReal), dimension(3) :: shift
|
||||
integer(pInt) , intent(in):: range_dim, domain_dim, spatial_dim
|
||||
real(pReal), dimension(spatial_dim,range_dim), intent(in) :: range_set
|
||||
real(pReal), dimension(spatial_dim,domain_dim), intent(in) :: domain_set
|
||||
real(pReal), dimension(spatial_dim,domain_dim*3_pInt**spatial_dim) :: domain_set_large
|
||||
integer(pInt):: i, j, k, l, m, n, ielem_large, ielem_small
|
||||
integer(pInt), dimension(range_dim), intent(out) :: map_range_to_domain
|
||||
|
||||
implicit none
|
||||
integer(pInt), dimension(3), intent(in) :: res_new
|
||||
integer(pInt), intent(in):: spatial_dim, Npoints_old
|
||||
real(pReal), dimension(3), intent(in) :: geomdim
|
||||
real(pReal), dimension(3,3), intent(in) :: defgrad_av
|
||||
real(pReal), dimension(spatial_dim,Npoints_old), intent(in) :: deformed_set
|
||||
|
||||
integer(pInt), dimension(res_new(1)*res_new(2)*res_new(3)), intent(out) :: result_indices
|
||||
|
||||
real(pReal), dimension(spatial_dim,Npoints_old*3_pInt**spatial_dim) :: deformed_set_large
|
||||
|
||||
integer(pInt):: i, j, k, ielem_small, ielem_large
|
||||
real(pReal), dimension(3) :: shift, query_point
|
||||
type(kdtree2), pointer :: tree
|
||||
type(kdtree2_result), dimension(1) :: map_1range_to_domain
|
||||
|
||||
type(kdtree2_result), dimension(1) :: Results
|
||||
|
||||
shift = math_mul33x3(defgrad_av,geomdim)
|
||||
ielem_small = 0_pInt
|
||||
ielem_large = 0_pInt
|
||||
do k = 1_pInt, res(3); do j = 1_pInt, res(2); do i = 1_pInt, res(1)
|
||||
ielem_small = ielem_small + 1_pInt
|
||||
do n = -1_pInt, 1_pInt
|
||||
do m = -1_pInt, 1_pInt
|
||||
do l = -1_pInt, 1_pInt
|
||||
ielem_large = ielem_large + 1_pInt
|
||||
domain_set_large(1:spatial_dim,ielem_large) = domain_set(1:spatial_dim,ielem_small)+ real((/l,m,n/),pReal)* shift
|
||||
enddo; enddo; enddo
|
||||
enddo; enddo; enddo
|
||||
|
||||
tree => kdtree2_create(domain_set_large,sort=.true.,rearrange=.true.) ! create a sorted tree
|
||||
do i = 1_pInt, range_dim
|
||||
call kdtree2_n_nearest(tp=tree, qv=range_set(1:spatial_dim,i), nn=1_pInt, results= map_1range_to_domain)
|
||||
map_range_to_domain(i) = map_1range_to_domain(1)%idx
|
||||
enddo
|
||||
|
||||
end subroutine
|
||||
do ielem_small=1_pInt, Npoints_old ! making copies (27 for 3D, 9 for 2D)
|
||||
do k = -1, 1
|
||||
do j = -1, 1
|
||||
do i = -1, 1
|
||||
ielem_large = ielem_large + 1_pInt
|
||||
deformed_set_large(1:spatial_dim,ielem_large) = &
|
||||
deformed_set(1:spatial_dim,ielem_small) + real([i,j,k],pReal)* shift
|
||||
enddo; enddo; enddo; enddo
|
||||
|
||||
tree => kdtree2_create(deformed_set_large,sort=.true.,rearrange=.true.)
|
||||
|
||||
do k=1_pInt,res_new(3); do j=1_pInt, res_new(2); do i=1_pInt, res_new(1)
|
||||
query_point = math_mul33x3(defgrad_av,(real([i,j,k],pReal)-0.5_pReal)/geomdim*real(res_new,pReal))
|
||||
call kdtree2_n_nearest(tp=tree, qv=query_point(1_pInt:spatial_dim),nn=1_pInt, results = Results)
|
||||
result_indices(i) = Results(1)%idx
|
||||
enddo; enddo; enddo
|
||||
|
||||
end subroutine math_nearestNeighborSearch
|
||||
|
||||
end module math
|
||||
|
|
|
|||
|
|
@ -139,7 +139,7 @@ execute = { \
|
|||
' %s'%(os.path.join(codeDir,'numerics.f90'))+\
|
||||
' %s'%(os.path.join(codeDir,'debug.f90'))+\
|
||||
' %s'%(os.path.join(codeDir,'math.f90'))+\
|
||||
' %s'%(os.path.join(codeDir,'DAMASK_python.f90'))+\
|
||||
' %s'%(os.path.join(codeDir,'DAMASK_quit.f90'))+\
|
||||
' -L%s/lib -lfftw3'%(damaskEnv.pathInfo['fftw'])+\
|
||||
' %s'%lib_lapack,
|
||||
'mv %s `readlink -f %s`' %(os.path.join(codeDir,'core.so'),os.path.join(damaskEnv.relPath('lib/damask'),'core.so')),
|
||||
|
|
|
|||
Loading…
Reference in New Issue