reworked python - fortran interfacing

This commit is contained in:
Krishna Komerla 2012-04-10 13:30:34 +00:00
parent b17740c9c3
commit d638c563af
9 changed files with 136 additions and 305 deletions

View File

@ -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

View File

@ -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

63
code/DAMASK_quit.f90 Normal file
View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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')),