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
|
|
||||||
|
|
@ -49,117 +49,22 @@ contains
|
||||||
!> @brief initializes the solver by interpreting the command line arguments. Also writes
|
!> @brief initializes the solver by interpreting the command line arguments. Also writes
|
||||||
!! information on computation on screen
|
!! 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, 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
|
implicit none
|
||||||
character(len=1024) :: commandLine, & !< command line call as string
|
character(len=1024) :: hostName, & !< name of computer
|
||||||
hostName, & !< name of computer
|
|
||||||
userName !< name of user calling the executable
|
userName !< name of user calling the executable
|
||||||
integer :: i, &
|
character(len=1024), intent(in) :: loadcaseParameterIn
|
||||||
start ,&
|
character(len=1024), intent(in) :: geometryParameterIn
|
||||||
length
|
|
||||||
integer, dimension(8) :: dateAndTime ! type default integer
|
integer, dimension(8) :: dateAndTime ! type default integer
|
||||||
|
|
||||||
call get_command(commandLine)
|
geometryParameter = loadcaseParameterIn
|
||||||
|
loadcaseParameter = geometryParameterIn
|
||||||
|
|
||||||
call date_and_time(values = dateAndTime)
|
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('HOST',hostName)
|
||||||
call GET_ENVIRONMENT_VARIABLE('USER',userName)
|
call GET_ENVIRONMENT_VARIABLE('USER',userName)
|
||||||
|
|
||||||
|
|
@ -176,10 +81,8 @@ subroutine DAMASK_interface_init
|
||||||
write(6,*) 'Host Name: ', trim(hostName)
|
write(6,*) 'Host Name: ', trim(hostName)
|
||||||
write(6,*) 'User Name: ', trim(userName)
|
write(6,*) 'User Name: ', trim(userName)
|
||||||
write(6,*) 'Path Separator: ', getPathSep()
|
write(6,*) 'Path Separator: ', getPathSep()
|
||||||
write(6,*) 'Command line call: ', trim(commandLine)
|
|
||||||
write(6,*) 'Geometry Parameter: ', trim(geometryParameter)
|
write(6,*) 'Geometry Parameter: ', trim(geometryParameter)
|
||||||
write(6,*) 'Loadcase Parameter: ', trim(loadcaseParameter)
|
write(6,*) 'Loadcase Parameter: ', trim(loadcaseParameter)
|
||||||
if (start/=3_pInt) write(6,*) 'Restart Parameter: ', trim(commandLine(start:start+length))
|
|
||||||
|
|
||||||
end subroutine DAMASK_interface_init
|
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)
|
call quit(0_pInt)
|
||||||
end program DAMASK_spectral
|
end program DAMASK_spectral
|
||||||
|
|
||||||
!********************************************************************
|
#include "DAMASK_quit.f90"
|
||||||
! 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
|
|
||||||
|
|
@ -929,31 +929,4 @@ program DAMASK_spectral_AL
|
||||||
call quit(1_pInt)
|
call quit(1_pInt)
|
||||||
end program DAMASK_spectral_AL
|
end program DAMASK_spectral_AL
|
||||||
|
|
||||||
!********************************************************************
|
#include "DAMASK_quit.f90"
|
||||||
! 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
|
|
||||||
|
|
@ -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
|
python module core ! in
|
||||||
interface ! in :core
|
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
|
module math ! in :math:math.f90
|
||||||
|
|
||||||
subroutine volume_compare(res,geomdim,defgrad,nodes,volume_mismatch) ! 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
|
! output variables
|
||||||
real*8, dimension(res[0],res[1],res[2]),intent(out),depend(res[0],res[1],res[2]) :: vm
|
real*8, dimension(res[0],res[1],res[2]),intent(out),depend(res[0],res[1],res[2]) :: vm
|
||||||
end subroutine math_equivStrain33_field
|
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 module math
|
||||||
end interface
|
end interface
|
||||||
end python module core
|
end python module core
|
||||||
|
|
|
||||||
|
|
@ -3820,43 +3820,46 @@ end subroutine calculate_cauchy
|
||||||
!############################################################################
|
!############################################################################
|
||||||
! subroutine to find nearest_neighbor.
|
! subroutine to find nearest_neighbor.
|
||||||
!############################################################################
|
!############################################################################
|
||||||
|
subroutine math_nearestNeighborSearch(res_new, Npoints_old, defgrad_av, geomdim, &
|
||||||
subroutine find_nearest_neighbor(res,geomdim,defgrad_av,spatial_dim,range_dim,domain_dim,&
|
spatial_dim, deformed_set, result_indices)
|
||||||
range_set,domain_set, map_range_to_domain)
|
|
||||||
use kdtree2_module
|
use kdtree2_module
|
||||||
|
|
||||||
|
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), intent(in) :: geomdim
|
||||||
real(pReal), dimension(3,3), intent(in) :: defgrad_av
|
real(pReal), dimension(3,3), intent(in) :: defgrad_av
|
||||||
integer(pInt), dimension(3), intent(in) :: res
|
real(pReal), dimension(spatial_dim,Npoints_old), intent(in) :: deformed_set
|
||||||
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
|
|
||||||
|
|
||||||
|
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), pointer :: tree
|
||||||
type(kdtree2_result), dimension(1) :: map_1range_to_domain
|
type(kdtree2_result), dimension(1) :: Results
|
||||||
|
|
||||||
shift = math_mul33x3(defgrad_av,geomdim)
|
shift = math_mul33x3(defgrad_av,geomdim)
|
||||||
ielem_small = 0_pInt
|
|
||||||
ielem_large = 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 ielem_small=1_pInt, Npoints_old ! making copies (27 for 3D, 9 for 2D)
|
||||||
do n = -1_pInt, 1_pInt
|
do k = -1, 1
|
||||||
do m = -1_pInt, 1_pInt
|
do j = -1, 1
|
||||||
do l = -1_pInt, 1_pInt
|
do i = -1, 1
|
||||||
ielem_large = ielem_large + 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
|
deformed_set_large(1:spatial_dim,ielem_large) = &
|
||||||
enddo; enddo; enddo
|
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
|
enddo; enddo; enddo
|
||||||
|
|
||||||
tree => kdtree2_create(domain_set_large,sort=.true.,rearrange=.true.) ! create a sorted tree
|
end subroutine math_nearestNeighborSearch
|
||||||
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
|
|
||||||
|
|
||||||
end module math
|
end module math
|
||||||
|
|
|
||||||
|
|
@ -139,7 +139,7 @@ execute = { \
|
||||||
' %s'%(os.path.join(codeDir,'numerics.f90'))+\
|
' %s'%(os.path.join(codeDir,'numerics.f90'))+\
|
||||||
' %s'%(os.path.join(codeDir,'debug.f90'))+\
|
' %s'%(os.path.join(codeDir,'debug.f90'))+\
|
||||||
' %s'%(os.path.join(codeDir,'math.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'])+\
|
' -L%s/lib -lfftw3'%(damaskEnv.pathInfo['fftw'])+\
|
||||||
' %s'%lib_lapack,
|
' %s'%lib_lapack,
|
||||||
'mv %s `readlink -f %s`' %(os.path.join(codeDir,'core.so'),os.path.join(damaskEnv.relPath('lib/damask'),'core.so')),
|
'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