223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Merge branch 'Python3' into new-test-server

This commit is contained in:
Martin Diehl 2019-02-14 21:14:50 +01:00
parent 2cda3cd0f9 889cfc8ba0
commit b4fd4afb15
14 changed files with 958 additions and 2149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
CMakeLists.txt
View File

@ -445,6 +445,33 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
# Additional options
# -fdefault-integer-8: Use it to set precision to 8 bytes for integer, don't use it for the standard case of pInt=4 (there is no -fdefault-integer-4)
###################################################################################################
# PGI Compiler
###################################################################################################
elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "PGI")
if (OPTIMIZATION STREQUAL "OFF")
set (OPTIMIZATION_FLAGS "-O0" )
elseif (OPTIMIZATION STREQUAL "DEFENSIVE")
set (OPTIMIZATION_FLAGS "-O2")
elseif (OPTIMIZATION STREQUAL "AGGRESSIVE")
set (OPTIMIZATION_FLAGS "-O3")
endif ()
#------------------------------------------------------------------------------------------------
# Fine tuning compilation options
set (COMPILE_FLAGS "${COMPILE_FLAGS} -Mpreprocess")
# preprocessor
set (STANDARD_CHECK "-Mallocatable=03")
#------------------------------------------------------------------------------------------------
# Runtime debugging
set (DEBUG_FLAGS "${DEBUG_FLAGS} -g")
# Includes debugging information in the object module; sets the optimization level to zero unless a -⁠O option is present on the command line
else ()
message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
endif ()

2
VERSION
View File

@ -1 +1 @@
v2.0.2-1674-g683dee82
v2.0.2-1689-g1a471bcd

2
processing/post/vtk_addGridData.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,vtk

2
processing/post/vtk_addPointcloudData.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,vtk

2
processing/post/vtk_addRectilinearGridData.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,vtk

2
processing/post/vtk_pointcloud.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys,vtk

2
processing/post/vtk_rectilinearGrid.py
View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7
#!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*-
import os,sys,vtk

10
src/C_routines.c
View File

@ -6,9 +6,11 @@
#include <sys/stat.h>
#include <stdio.h>
#include <string.h>
#include <signal.h>
/* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
int isdirectory_c(const char *dir){
struct stat statbuf;
if(stat(dir, &statbuf) != 0) /* error */
@ -44,3 +46,11 @@ void gethostname_c(char hostname[], int *stat){
int chdir_c(const char *dir){
return chdir(dir);
}
void signalusr1_c(void (*handler)(int)){
signal(SIGUSR1, handler);
}
void signalusr2_c(void (*handler)(int)){
signal(SIGUSR2, handler);
}

44
src/DAMASK_interface.f90
View File

@ -12,9 +12,9 @@
module DAMASK_interface
use prec, only: &
pInt
implicit none
private
logical, public, protected :: SIGUSR1,SIGUSR2
integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: &
@ -42,6 +42,8 @@ contains
subroutine DAMASK_interface_init()
use, intrinsic :: &
iso_fortran_env
use :: &
iso_c_binding
#include <petsc/finclude/petscsys.h>
#if defined(__GFORTRAN__) && __GNUC__ < 5
===================================================================================================
@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
use PETScSys
use system_routines, only: &
signalusr1_C, &
signalusr2_C, &
getHostName, &
getCWD
@ -229,6 +233,12 @@ subroutine DAMASK_interface_init()
if (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc
call signalusr1_c(c_funloc(setSIGUSR1))
call signalusr2_c(c_funloc(setSIGUSR2))
SIGUSR1 = .false.
SIGUSR2 = .false.
end subroutine DAMASK_interface_init
@ -412,6 +422,35 @@ character(len=1024) function makeRelativePath(a,b)
end function makeRelativePath
!--------------------------------------------------------------------------------------------------
!> @brief sets global variable SIGUSR1 to .true. if program receives SIGUSR1
!--------------------------------------------------------------------------------------------------
subroutine setSIGUSR1(signal) bind(C)
use :: iso_c_binding
implicit none
integer(C_INT), value :: signal
SIGUSR1 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR1'
end subroutine setSIGUSR1
!--------------------------------------------------------------------------------------------------
!> @brief sets global variable SIGUSR2 to .true. if program receives SIGUSR2
!--------------------------------------------------------------------------------------------------
subroutine setSIGUSR2(signal) bind(C)
use :: iso_c_binding
implicit none
integer(C_INT), value :: signal
SIGUSR2 = .true.
write(6,*) 'received signal ',signal, 'set SIGUSR2'
end subroutine setSIGUSR2
!--------------------------------------------------------------------------------------------------
!> @brief taken from IO, check IO_stringValue for documentation
@ -469,11 +508,10 @@ pure function IIO_stringPos(string)
do while (verify(string(right+1:),SEP)>0)
left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit
IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
enddo
end function IIO_stringPos
end module
end module

8
src/FEM_utilities.f90
View File

@ -162,7 +162,6 @@ subroutine utilities_init()
character(len=1024) :: petsc_optionsPhysics
integer(pInt) :: dimPlex
integer(pInt) :: headerID = 205_pInt
PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:)
PetscInt :: dim
PetscErrorCode :: ierr
@ -213,13 +212,6 @@ subroutine utilities_init()
nOutputCells(worldrank+1) = count(material_homog > 0_pInt)
call MPI_Allreduce(MPI_IN_PLACE,nOutputNodes,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
call MPI_Allreduce(MPI_IN_PLACE,nOutputCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr)
if (worldrank == 0_pInt) then
open(unit=headerID, file=trim(getSolverJobName())//'.header', &
form='FORMATTED', status='REPLACE')
write(headerID, '(a,i0)') 'dimension : ', dimPlex
write(headerID, '(a,i0)') 'number of nodes : ', sum(nOutputNodes)
write(headerID, '(a,i0)') 'number of cells : ', sum(nOutputCells)
endif
end subroutine utilities_init

2759
src/HDF5_utilities.f90
View File

File diff suppressed because it is too large Load Diff

6
src/compilation_info.f90
View File

@ -1,9 +1,13 @@
! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with ', compiler_version()
write(6,*) 'With options ', compiler_options()
#else
#elif defined(__INTEL_COMPILER)
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
', build date ', __INTEL_COMPILER_BUILD_DATE
#elif defined(__PGI)
write(6,'(a,i4.4,a,i8.8)') ' Compiled with PGI fortran version ', __PGIC__,&
'.', __PGIC_MINOR__
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,*)

93
src/math.f90
View File

@ -118,6 +118,9 @@ module math
!---------------------------------------------------------------------------------------------------
public :: &
#if defined(__PGI)
norm2, &
#endif
math_init, &
math_qsort, &
math_expand, &
@ -351,20 +354,38 @@ end subroutine math_check
!--------------------------------------------------------------------------------------------------
!> @brief Quicksort algorithm for two-dimensional integer arrays
! Sorting is done with respect to array(1,:)
! and keeps array(2:N,:) linked to it.
! Sorting is done with respect to array(sort,:) and keeps array(/=sort,:) linked to it.
! default: sort=1
!--------------------------------------------------------------------------------------------------
recursive subroutine math_qsort(a, istart, iend)
recursive subroutine math_qsort(a, istart, iend, sortDim)
implicit none
integer(pInt), dimension(:,:), intent(inout) :: a
integer(pInt), intent(in) :: istart,iend
integer(pInt) :: ipivot
if (istart < iend) then
ipivot = qsort_partition(a,istart, iend)
call math_qsort(a, istart, ipivot-1_pInt)
call math_qsort(a, ipivot+1_pInt, iend)
integer(pInt), intent(in),optional :: istart,iend, sortDim
integer(pInt) :: ipivot,s,e,d
if(present(istart)) then
s = istart
else
s = lbound(a,2)
endif
if(present(iend)) then
e = iend
else
e = ubound(a,2)
endif
if(present(sortDim)) then
d = sortDim
else
d = 1
endif
if (s < e) then
ipivot = qsort_partition(a,s, e, d)
call math_qsort(a, s, ipivot-1_pInt, d)
call math_qsort(a, ipivot+1_pInt, e, d)
endif
!--------------------------------------------------------------------------------------------------
@ -373,37 +394,34 @@ recursive subroutine math_qsort(a, istart, iend)
!-------------------------------------------------------------------------------------------------
!> @brief Partitioning required for quicksort
!-------------------------------------------------------------------------------------------------
integer(pInt) function qsort_partition(a, istart, iend)
integer(pInt) function qsort_partition(a, istart, iend, sort)
implicit none
integer(pInt), dimension(:,:), intent(inout) :: a
integer(pInt), intent(in) :: istart,iend
integer(pInt) :: i,j,k,tmp
integer(pInt), intent(in) :: istart,iend,sort
integer(pInt), dimension(size(a,1)) :: tmp
integer(pInt) :: i,j
do
! find the first element on the right side less than or equal to the pivot point
! find the first element on the right side less than or equal to the pivot point
do j = iend, istart, -1_pInt
if (a(1,j) <= a(1,istart)) exit
if (a(sort,j) <= a(sort,istart)) exit
enddo
! find the first element on the left side greater than the pivot point
! find the first element on the left side greater than the pivot point
do i = istart, iend
if (a(1,i) > a(1,istart)) exit
if (a(sort,i) > a(sort,istart)) exit
enddo
if (i < j) then ! if the indexes do not cross, exchange values
do k = 1_pInt, int(size(a,1_pInt), pInt)
tmp = a(k,i)
a(k,i) = a(k,j)
a(k,j) = tmp
enddo
else ! if they do cross, exchange left value with pivot and return with the partition index
do k = 1_pInt, int(size(a,1_pInt), pInt)
tmp = a(k,istart)
a(k,istart) = a(k,j)
a(k,j) = tmp
enddo
cross: if (i >= j) then ! if the indices cross, exchange left value with pivot and return with the partition index
tmp = a(:,istart)
a(:,istart) = a(:,j)
a(:,j) = tmp
qsort_partition = j
return
endif
else cross ! if they do not cross, exchange values
tmp = a(:,i)
a(:,i) = a(:,j)
a(:,j) = tmp
endif cross
enddo
end function qsort_partition
@ -2707,4 +2725,19 @@ real(pReal) pure elemental function math_clip(a, left, right)
end function math_clip
#if defined(__PGI)
!--------------------------------------------------------------------------------------------------
!> @brief substitute for the norm2 intrinsic which is not available in PGI 18.10
!--------------------------------------------------------------------------------------------------
real(pReal) pure function norm2(v)
implicit none
real(pReal), intent(in), dimension(3) :: v
norm2 = sqrt(sum(v**2))
end function norm2
#endif
end module math

148
src/system_routines.f90
View File

@ -3,11 +3,17 @@
!> @brief provides wrappers to C routines
!--------------------------------------------------------------------------------------------------
module system_routines
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
private
public :: &
signalusr1_C, &
signalusr2_C, &
isDirectory, &
getCWD, &
getHostName, &
@ -27,7 +33,7 @@ interface
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat
end subroutine getCurrentWorkDir_C
@ -35,7 +41,7 @@ interface
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
character(kind=C_CHAR), dimension(1024), intent(out) :: str ! C string is an array
integer(C_INT),intent(out) :: stat
end subroutine getHostName_C
@ -46,31 +52,38 @@ interface
integer(C_INT) :: chdir_C
character(kind=C_CHAR), dimension(1024), intent(in) :: path ! C string is an array
end function chdir_C
subroutine signalusr1_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr1_C
subroutine signalusr2_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr2_C
end interface
contains
!--------------------------------------------------------------------------------------------------
!> @brief figures out if a given path is a directory (and not an ordinary file)
!--------------------------------------------------------------------------------------------------
logical function isDirectory(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength
integer :: i
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string as array
integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
isDirectory=merge(.True.,.False.,isDirectory_C(strFixedLength) /= 0_C_INT)
end function isDirectory
@ -79,29 +92,25 @@ end function isDirectory
!> @brief gets the current working directory
!--------------------------------------------------------------------------------------------------
character(len=1024) function getCWD()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
call getCurrentWorkDir_C(charArray,stat)
if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory'
else
getCWD = repeat('',len(getCWD))
arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
call getCurrentWorkDir_C(charArray,stat)
if (stat /= 0_C_INT) then
getCWD = 'Error occured when getting currend working directory'
else
getCWD = repeat('',len(getCWD))
arrayToString: do i=1,len(getCWD)
if (charArray(i) /= C_NULL_CHAR) then
getCWD(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
end function getCWD
@ -110,51 +119,42 @@ end function getCWD
!> @brief gets the current host name
!--------------------------------------------------------------------------------------------------
character(len=1024) function getHostName()
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
implicit none
character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array
integer(C_INT) :: stat
integer :: i
call getHostName_C(charArray,stat)
if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name'
else
getHostName = repeat('',len(getHostName))
arrayToString: do i=1,len(getHostName)
if (charArray(i) /= C_NULL_CHAR) then
getHostName(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
call getHostName_C(charArray,stat)
if (stat /= 0_C_INT) then
getHostName = 'Error occured when getting host name'
else
getHostName = repeat('',len(getHostName))
arrayToString: do i=1,len(getHostName)
if (charArray(i) /= C_NULL_CHAR) then
getHostName(i:i)=charArray(i)
else
exit
endif
enddo arrayToString
endif
end function getHostName
!--------------------------------------------------------------------------------------------------
!> @brief changes the current working directory
!--------------------------------------------------------------------------------------------------
logical function setCWD(path)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR, &
C_NULL_CHAR
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer :: i
implicit none
character(len=*), intent(in) :: path
character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array
integer :: i
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
strFixedLength = repeat(C_NULL_CHAR,len(strFixedLength))
do i=1,len(path) ! copy array components
strFixedLength(i)=path(i:i)
enddo
setCWD=merge(.True.,.False.,chdir_C(strFixedLength) /= 0_C_INT)
end function setCWD