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

Merge remote-tracking branch 'origin/development' into python-improvements

This commit is contained in:
Martin Diehl 2020-11-16 22:57:49 +01:00
parent a8fec922d5 c16ad845bc
commit cd8434b991
12 changed files with 159 additions and 250 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
.gitlab-ci.yml
View File

@ -187,8 +187,6 @@ grid_mech_compile_Intel:
stage: compilePETSc
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- cp -r grid_mech_compile grid_mech_compile_Intel
- grid_mech_compile_Intel/test.py
- cd pytest
- pytest -k 'compile and grid' --basetemp=${TESTROOT}/compile_grid_Intel
except:
@ -199,8 +197,6 @@ Compile_FEM_Intel:
stage: compilePETSc
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- cp -r FEM_compile FEM_compile_Intel
- FEM_compile_Intel/test.py
- cd pytest
- pytest -k 'compile and mesh' --basetemp=${TESTROOT}/compile_mesh_Intel
except:
@ -211,8 +207,6 @@ grid_mech_compile_GNU:
stage: compilePETSc
script:
- module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU
- cp -r grid_mech_compile grid_mech_compile_GNU
- grid_mech_compile_GNU/test.py
- cd pytest
- pytest -k 'compile and grid' --basetemp=${TESTROOT}/compile_grid_GNU
except:
@ -223,8 +217,6 @@ Compile_FEM_GNU:
stage: compilePETSc
script:
- module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU
- cp -r FEM_compile FEM_compile_GNU
- FEM_compile_GNU/test.py
- cd pytest
- pytest -k 'compile and mesh' --basetemp=${TESTROOT}/compile_mesh_GNU
except:
@ -274,22 +266,6 @@ Nonlocal_Damage_DetectChanges:
- master
- release
grid_all_restart:
stage: grid
script: grid_all_restart/test.py
except:
- master
- release
grid_all_restartMPI:
stage: grid
script:
- module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel
- grid_all_restartMPI/test.py
except:
- master
- release
Plasticity_DetectChanges:
stage: grid
script: Plasticity_DetectChanges/test.py

2
PRIVATE

@ -1 +1 @@
Subproject commit 281e7eb84f76a2974a50eb54faf35ea25ec89b20
Subproject commit 2105ed1c6e4800050010ca4d73b1882022f81551

69
processing/pre/geom_fromMinimalSurface.py
View File

@ -1,69 +0,0 @@
#!/usr/bin/env python3
import os
import sys
from optparse import OptionParser
import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0]
scriptID = ' '.join([scriptName,damask.version])
minimal_surfaces = list(damask.Geom._minimal_surface.keys())
# --------------------------------------------------------------------
# MAIN
# --------------------------------------------------------------------
parser = OptionParser(usage='%prog options [geomfile]', description = """
Generate a bicontinuous structure of given type.
""", version = scriptID)
parser.add_option('-t','--type',
dest = 'type',
choices = minimal_surfaces, metavar = 'string',
help = 'type of minimal surface [primitive] {%s}' %(','.join(minimal_surfaces)))
parser.add_option('-f','--threshold',
dest = 'threshold',
type = 'float', metavar = 'float',
help = 'threshold value defining minimal surface [%default]')
parser.add_option('-g', '--grid',
dest = 'grid',
type = 'int', nargs = 3, metavar = 'int int int',
help = 'a,b,c grid of hexahedral box [%default]')
parser.add_option('-s', '--size',
dest = 'size',
type = 'float', nargs = 3, metavar = 'float float float',
help = 'x,y,z size of hexahedral box [%default]')
parser.add_option('-p', '--periods',
dest = 'periods',
type = 'int', metavar = 'int',
help = 'number of repetitions of unit cell [%default]')
parser.add_option('--m',
dest = 'microstructure',
type = 'int', nargs = 2, metavar = 'int int',
help = 'two microstructure indices to be used [%default]')
parser.set_defaults(type = minimal_surfaces[0],
threshold = 0.0,
periods = 1,
grid = (16,16,16),
size = (1.0,1.0,1.0),
microstructure = (1,2),
)
(options,filename) = parser.parse_args()
name = None if filename == [] else filename[0]
damask.util.report(scriptName,name)
geom=damask.Geom.from_minimal_surface(options.grid,options.size,options.type,options.threshold,
options.periods,options.microstructure)
damask.util.croak(geom)
geom.save_ASCII(sys.stdout if name is None else name)

9
python/damask/_environment.py
View File

@ -3,10 +3,6 @@ from pathlib import Path
class Environment:
def __init__(self):
"""Do Nothing."""
pass
@property
def screen_size(self):
try:
@ -43,8 +39,3 @@ class Environment:
def root_dir(self):
"""Return DAMASK root path."""
return Path(__file__).parents[2]
# for compatibility
def rootDir(self):
return str(self.root_dir)

5
python/damask/_table.py
View File

@ -31,7 +31,7 @@ class Table:
def __repr__(self):
"""Brief overview."""
return util.srepr(self.comments)+'\n'+self.data.__repr__()
return '\n'.join(['# '+c for c in self.comments])+'\n'+self.data.__repr__()
def __len__(self):
"""Number of rows."""
@ -159,7 +159,7 @@ class Table:
comments = [util.execution_stamp('Table','from_ang')]
for line in content:
if line.startswith('#'):
comments.append(line.strip())
comments.append(line.split('#',1)[1].strip())
else:
break
@ -222,6 +222,7 @@ class Table:
dup.data[label] = data.reshape(dup.data[label].shape)
return dup
def add(self,label,data,info=None):
"""
Add column data.

36
src/C_routines.c
View File

@ -4,25 +4,24 @@
#include <dirent.h>
#include <string.h>
#include <signal.h>
#include <pwd.h>
#include <sys/types.h>
#include <sys/stat.h>
#include "zlib.h"
/* http://stackoverflow.com/questions/30279228/is-there-an-alternative-to-getcwd-in-fortran-2003-2008 */
#define PATHLEN 4096
#define STRLEN 256
int isdirectory_c(const char *dir){
struct stat statbuf;
if(stat(dir, &statbuf) != 0) /* error */
return 0; /* return "NO, this is not a directory" */
return S_ISDIR(statbuf.st_mode); /* 1 => is directory, 0 => this is NOT a directory */
int setcwd_c(const char *cwd){
return chdir(cwd);
}
void getcurrentworkdir_c(char cwd[], int *stat ){
char cwd_tmp[4096];
if(getcwd(cwd_tmp, sizeof(cwd_tmp)) == cwd_tmp){
strcpy(cwd,cwd_tmp);
void getcwd_c(char cwd[], int *stat ){
char cwd_tmp[PATHLEN+1];
if(getcwd(cwd_tmp, sizeof(cwd_tmp))){
strcpy(cwd,cwd_tmp); // getcwd guarantees a NULL-terminated string
*stat = 0;
}
else{
@ -32,9 +31,9 @@ void getcurrentworkdir_c(char cwd[], int *stat ){
void gethostname_c(char hostname[], int *stat){
char hostname_tmp[4096];
char hostname_tmp[STRLEN];
if(gethostname(hostname_tmp, sizeof(hostname_tmp)) == 0){
strcpy(hostname,hostname_tmp);
strncpy(hostname,hostname_tmp,sizeof(hostname_tmp)+1); // gethostname does not guarantee a NULL-terminated string
*stat = 0;
}
else{
@ -43,10 +42,18 @@ void gethostname_c(char hostname[], int *stat){
}
int chdir_c(const char *dir){
return chdir(dir);
void getusername_c(char username[], int *stat){
struct passwd *pw = getpwuid(geteuid());
if(pw && strlen(pw->pw_name) <= STRLEN){
strncpy(username,pw->pw_name,STRLEN+1);
*stat = 0;
}
else{
*stat = 1;
}
}
void signalterm_c(void (*handler)(int)){
signal(SIGTERM, handler);
}
@ -59,6 +66,7 @@ void signalusr2_c(void (*handler)(int)){
signal(SIGUSR2, handler);
}
void inflate_c(const uLong *s_deflated, const uLong *s_inflated, const Byte deflated[], Byte inflated[]){
/* make writable copy, uncompress will write to it */
uLong s_inflated_,i;

29
src/DAMASK_interface.f90
View File

@ -69,8 +69,6 @@ subroutine DAMASK_interface_init
loadCaseArg = '', & !< -l argument given to the executable
geometryArg = '', & !< -g argument given to the executable
workingDirArg = '' !< -w argument given to the executable
character(len=pStringLen) :: &
userName !< name of user calling the executable
integer :: &
stat, &
i
@ -117,6 +115,9 @@ subroutine DAMASK_interface_init
print'(/,a)', ' Compiled on: '//__DATE__//' at '//__TIME__
print'(/,a,i0,a,i0,a,i0)', &
' PETSc version: ',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.',PETSC_VERSION_SUBMINOR
call date_and_time(values = dateAndTime)
print'(/,a,2(i2.2,a),i4.4)', ' Date: ',dateAndTime(3),'/',dateAndTime(2),'/', dateAndTime(1)
print'(a,2(i2.2,a),i2.2)', ' Time: ',dateAndTime(5),':', dateAndTime(6),':', dateAndTime(7)
@ -126,9 +127,9 @@ subroutine DAMASK_interface_init
if (err /= 0) call quit(1)
select case(trim(arg)) ! extract key
case ('-h','--help')
print'(a)', ' #######################################################################'
print'(/,a)',' #######################################################################'
print'(a)', ' DAMASK Command Line Interface:'
print'(a)', ' For PETSc-based solvers for the Düsseldorf Advanced Material Simulation Kit'
print'(a)', ' Düsseldorf Advanced Material Simulation Kit with PETSc-based solvers'
print'(a,/)',' #######################################################################'
print'(a,/)',' Valid command line switches:'
print'(a)', ' --geom (-g, --geometry)'
@ -189,17 +190,15 @@ subroutine DAMASK_interface_init
interface_loadFile = getLoadCaseFile(loadCaseArg)
call get_command(commandLine)
call get_environment_variable('USER',userName)
! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux
print'(a)', ' Host name: '//trim(getHostName())
print'(a)', ' User name: '//trim(userName)
print'(/,a)', ' Host name: '//getHostName()
print'(a)', ' User name: '//getUserName()
print'(/a)', ' Command line call: '//trim(commandLine)
if (len_trim(workingDirArg) > 0) &
print'(a)', ' Working dir argument: '//trim(workingDirArg)
print'(a)', ' Geometry argument: '//trim(geometryArg)
print'(a)', ' Load case argument: '//trim(loadcaseArg)
print'(a)', ' Working directory: '//getCWD()
print'(a)', ' Loadcase argument: '//trim(loadcaseArg)
print'(/,a)', ' Working directory: '//getCWD()
print'(a)', ' Geometry file: '//interface_geomFile
print'(a)', ' Loadcase file: '//interface_loadFile
print'(a)', ' Solver job name: '//getSolverJobName()
@ -222,8 +221,8 @@ end subroutine DAMASK_interface_init
!--------------------------------------------------------------------------------------------------
subroutine setWorkingDirectory(workingDirectoryArg)
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=pPathLen) :: workingDirectory
character(len=*), intent(in) :: workingDirectoryArg !< working directory argument
character(len=:), allocatable :: workingDirectory
logical :: error
external :: quit
@ -359,12 +358,12 @@ end function rectifyPath
!--------------------------------------------------------------------------------------------------
!> @brief relative path from absolute a to absolute b
!> @brief Determine relative path from absolute a to absolute b
!--------------------------------------------------------------------------------------------------
function makeRelativePath(a,b)
character (len=*), intent(in) :: a,b
character (len=pPathLen) :: a_cleaned,b_cleaned
character(len=*), intent(in) :: a,b
character(len=pPathLen) :: a_cleaned,b_cleaned
character(len=:), allocatable :: makeRelativePath
integer :: i,posLastCommonSlash,remainingSlashes

2
src/grid/grid_mech_spectral_polarisation.f90
View File

@ -498,7 +498,7 @@ subroutine converged(snes_local,PETScIter,devNull1,devNull2,devNull3,reason,dumm
err_div/divTol, ' (',err_div, ' / m, tol = ',divTol,')'
print '(a,f12.2,a,es8.2,a,es9.2,a)', ' error curl = ', &
err_curl/curlTol,' (',err_curl,' -, tol = ',curlTol,')'
print '(a,f12.2,a,es8.2,a,es9.2,a)', ' error stress BC = ', &
print '(a,f12.2,a,es8.2,a,es9.2,a)', ' error stress BC = ', &
err_BC/BCTol, ' (',err_BC, ' Pa, tol = ',BCTol,')'
print'(/,a)', ' ==========================================================================='
flush(IO_STDOUT)

23
src/grid/spectral_utilities.f90
View File

@ -993,12 +993,11 @@ subroutine utilities_updateCoords(F)
real(pReal), dimension(3, grid(1)+1,grid(2)+1,grid3+1) :: nodeCoords
integer :: &
i,j,k,n, &
rank_t, &
rank_b, &
c, r, &
rank_t, rank_b, &
c, &
ierr
integer, dimension(MPI_STATUS_SIZE) :: &
s
integer, dimension(4) :: request
integer, dimension(MPI_STATUS_SIZE,4) :: status
real(pReal), dimension(3) :: step
real(pReal), dimension(3,3) :: Favg
integer, dimension(3) :: me
@ -1044,20 +1043,20 @@ subroutine utilities_updateCoords(F)
rank_b = modulo(worldrank-1,worldsize)
! send bottom layer to process below
call MPI_Isend(IPfluct_padded(:,:,:,2), c,MPI_DOUBLE,rank_b,0,PETSC_COMM_WORLD,r,ierr)
call MPI_Isend(IPfluct_padded(:,:,:,2), c,MPI_DOUBLE,rank_b,0,PETSC_COMM_WORLD,request(1),ierr)
if(ierr /=0) error stop 'MPI error'
call MPI_Irecv(IPfluct_padded(:,:,:,grid3+2),c,MPI_DOUBLE,rank_t,0,PETSC_COMM_WORLD,r,ierr)
if(ierr /=0) error stop 'MPI error'
call MPI_Wait(r,s,ierr)
call MPI_Irecv(IPfluct_padded(:,:,:,grid3+2),c,MPI_DOUBLE,rank_t,0,PETSC_COMM_WORLD,request(2),ierr)
if(ierr /=0) error stop 'MPI error'
! send top layer to process above
call MPI_Isend(IPfluct_padded(:,:,:,grid3+1),c,MPI_DOUBLE,rank_t,0,PETSC_COMM_WORLD,r,ierr)
call MPI_Isend(IPfluct_padded(:,:,:,grid3+1),c,MPI_DOUBLE,rank_t,1,PETSC_COMM_WORLD,request(3),ierr)
if(ierr /=0) error stop 'MPI error'
call MPI_Irecv(IPfluct_padded(:,:,:,1), c,MPI_DOUBLE,rank_b,0,PETSC_COMM_WORLD,r,ierr)
call MPI_Irecv(IPfluct_padded(:,:,:,1), c,MPI_DOUBLE,rank_b,1,PETSC_COMM_WORLD,request(4),ierr)
if(ierr /=0) error stop 'MPI error'
call MPI_Wait(r,s,ierr)
call MPI_Waitall(4,request,status,ierr)
if(ierr /=0) error stop 'MPI error'
if(any(status(MPI_ERROR,:) /= 0)) error stop 'MPI error'
!--------------------------------------------------------------------------------------------------
! calculate nodal displacements

69
src/mesh/DAMASK_mesh.f90
View File

@ -20,7 +20,7 @@ program DAMASK_mesh
use discretization_mesh
use FEM_Utilities
use mesh_mech_FEM
implicit none
!--------------------------------------------------------------------------------------------------
@ -56,7 +56,7 @@ program DAMASK_mesh
totalIncsCounter = 0, & !< total # of increments
statUnit = 0, & !< file unit for statistics output
stagIter, &
component
component
class(tNode), pointer :: &
num_mesh
character(len=pStringLen), dimension(:), allocatable :: fileContent
@ -80,7 +80,7 @@ program DAMASK_mesh
call CPFEM_initAll
print'(/,a)', ' <<<+- DAMASK_mesh init -+>>>'; flush(IO_STDOUT)
!---------------------------------------------------------------------
!---------------------------------------------------------------------
! reading field information from numerics file and do sanity checks
num_mesh => config_numerics%get('mesh', defaultVal=emptyDict)
stagItMax = num_mesh%get_asInt('maxStaggeredIter',defaultVal=10)
@ -100,7 +100,7 @@ program DAMASK_mesh
do l = 1, size(fileContent)
line = fileContent(l)
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1, chunkPos(1) ! reading compulsory parameters for loadcase
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
@ -109,15 +109,16 @@ program DAMASK_mesh
end select
enddo ! count all identifiers to allocate memory and do sanity check
enddo
allocate (loadCases(N_def))
if(N_def < 1) call IO_error(error_ID = 837)
allocate(loadCases(N_def))
do i = 1, size(loadCases)
allocate(loadCases(i)%fieldBC(nActiveFields))
field = 1
loadCases(i)%fieldBC(field)%ID = FIELD_MECH_ID
enddo
do i = 1, size(loadCases)
do field = 1, nActiveFields
select case (loadCases(i)%fieldBC(field)%ID)
@ -133,21 +134,21 @@ program DAMASK_mesh
case (3)
loadCases(i)%fieldBC(field)%componentBC(component)%ID = COMPONENT_MECH_Z_ID
end select
enddo
enddo
end select
do component = 1, loadCases(i)%fieldBC(field)%nComponents
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Value(mesh_Nboundaries), source = 0.0_pReal)
allocate(loadCases(i)%fieldBC(field)%componentBC(component)%Mask (mesh_Nboundaries), source = .false.)
enddo
enddo
enddo
enddo
enddo
!--------------------------------------------------------------------------------------------------
! reading the load case and assign values to the allocated data structure
do l = 1, size(fileContent)
line = fileContent(l)
if (IO_isBlank(line)) cycle ! skip empty lines
chunkPos = IO_stringPos(line)
do i = 1, chunkPos(1)
select case (IO_lc(IO_stringValue(line,chunkPos,i)))
@ -161,7 +162,7 @@ program DAMASK_mesh
do faceSet = 1, mesh_Nboundaries
if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet
enddo
if (currentFaceSet < 0) call IO_error(error_ID = errorID, ext_msg = 'invalid BC')
if (currentFaceSet < 0) call IO_error(error_ID = 837, ext_msg = 'invalid BC')
case('t','time','delta') ! increment time
loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1)
case('n','incs','increments','steps') ! number of increments
@ -170,7 +171,7 @@ program DAMASK_mesh
loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1)
loadCases(currentLoadCase)%logscale = 1
case('freq','frequency','outputfreq') ! frequency of result writings
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1)
loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1)
case('guessreset','dropguessing')
loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory
@ -185,7 +186,7 @@ program DAMASK_mesh
case('z')
ID = COMPONENT_MECH_Z_ID
end select
do field = 1, nActiveFields
if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then
do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents
@ -197,11 +198,11 @@ program DAMASK_mesh
endif
enddo
endif
enddo
enddo
end select
enddo
enddo
!--------------------------------------------------------------------------------------------------
! consistency checks and output of load case
loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase
@ -215,17 +216,17 @@ program DAMASK_mesh
select case (loadCases(currentLoadCase)%fieldBC(field)%ID)
case(FIELD_MECH_ID)
print'(a)', ' Field '//trim(FIELD_MECH_label)
end select
do faceSet = 1, mesh_Nboundaries
do component = 1, loadCases(currentLoadCase)%fieldBC(field)%nComponents
if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) &
print'(a,i2,a,i2,a,f12.7)', ' Face ', mesh_boundaries(faceSet), &
' Component ', component, &
' Component ', component, &
' Value ', loadCases(currentLoadCase)%fieldBC(field)% &
componentBC(component)%Value(faceSet)
enddo
enddo
enddo
enddo
print'(a,f12.6)', ' time: ', loadCases(currentLoadCase)%time
if (loadCases(currentLoadCase)%incs < 1) errorID = 835 ! non-positive incs count
@ -244,7 +245,7 @@ program DAMASK_mesh
case(FIELD_MECH_ID)
call FEM_mech_init(loadCases(1)%fieldBC(field))
end select
enddo
enddo
if (worldrank == 0) then
open(newunit=statUnit,file=trim(getSolverJobName())//'.sta',form='FORMATTED',status='REPLACE')
@ -254,9 +255,9 @@ program DAMASK_mesh
loadCaseLooping: do currentLoadCase = 1, size(loadCases)
time0 = time ! load case start time
guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc
incLooping: do inc = 1, loadCases(currentLoadCase)%incs
totalIncsCounter = totalIncsCounter + 1
totalIncsCounter = totalIncsCounter + 1
!--------------------------------------------------------------------------------------------------
! forwarding time
@ -266,7 +267,7 @@ program DAMASK_mesh
else
if (currentLoadCase == 1) then ! 1st load case of logarithmic scale
if (inc == 1) then ! 1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
timeinc = loadCases(1)%time*(2.0_pReal**real( 1-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd
else ! not-1st inc of 1st load case of logarithmic scale
timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1-loadCases(1)%incs ,pReal))
endif
@ -287,7 +288,7 @@ program DAMASK_mesh
remainingLoadCaseTime = loadCases(currentLoadCase)%time+time0 - time
time = time + timeinc ! forward target time
stepFraction = stepFraction + 1 ! count step
!--------------------------------------------------------------------------------------------------
! report begin of new step
print'(/,a)', ' ###########################################################################'
@ -310,8 +311,8 @@ program DAMASK_mesh
guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field))
end select
enddo
enddo
!--------------------------------------------------------------------------------------------------
! solve fields
stagIter = 0
@ -332,10 +333,10 @@ program DAMASK_mesh
stagIterate = stagIter < stagItMax &
.and. all(solres(:)%converged) &
.and. .not. all(solres(:)%stagConverged) ! stationary with respect to staggered iteration
enddo
! check solution
cutBack = .False.
enddo
! check solution
cutBack = .False.
if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found
if (cutBackLevel < maxCutBack) then ! do cut back
print'(/,a)', ' cut back detected'
@ -344,7 +345,7 @@ program DAMASK_mesh
cutBackLevel = cutBackLevel + 1
time = time - timeinc ! rewind time
timeinc = timeinc/2.0_pReal
else ! default behavior, exit if spectral solver does not converge
else ! default behavior, exit if spectral solver does not converge
call IO_warning(850)
call quit(1) ! quit
endif
@ -374,8 +375,8 @@ program DAMASK_mesh
enddo incLooping
enddo loadCaseLooping
!--------------------------------------------------------------------------------------------------
! report summary of whole calculation
print'(/,a)', ' ###########################################################################'

5
src/mesh/discretization_mesh.f90
View File

@ -17,6 +17,7 @@ module discretization_mesh
use IO
use config
use discretization
use results
use FEsolving
use FEM_quadrature
use YAML_types
@ -182,6 +183,10 @@ subroutine discretization_mesh_init(restart)
reshape(mesh_ipCoordinates,[3,mesh_maxNips*mesh_NcpElems]), &
mesh_node0)
call results_openJobFile
call results_closeGroup(results_addGroup('geometry'))
call results_closeJobFile
end subroutine discretization_mesh_init

136
src/system_routines.f90
View File

@ -8,79 +8,65 @@ module system_routines
use prec
implicit none
private
public :: &
signalterm_C, &
signalusr1_C, &
signalusr2_C, &
isDirectory, &
setCWD, &
getCWD, &
getHostName, &
setCWD
getUserName, &
signalterm_C, &
signalusr1_C, &
signalusr2_C
interface
function isDirectory_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
function setCWD_C(cwd) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
integer(C_INT) :: setCWD_C
character(kind=C_CHAR), dimension(*), intent(in) :: cwd
end function setCWD_C
subroutine getCWD_C(cwd, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
use prec
integer(C_INT) :: isDirectory_C
character(kind=C_CHAR), dimension(pPathLen), intent(in) :: path ! C string is an array
end function isDirectory_C
subroutine getCurrentWorkDir_C(path, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
use prec
character(kind=C_CHAR), dimension(pPathLen), intent(out) :: path ! C string is an array
integer(C_INT), intent(out) :: stat
end subroutine getCurrentWorkDir_C
subroutine getHostName_C(str, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
use prec
character(kind=C_CHAR), dimension(pStringLen), intent(out) :: str ! C string is an array
character(kind=C_CHAR), dimension(pPathLen+1), intent(out) :: cwd ! NULL-terminated array
integer(C_INT), intent(out) :: stat
end subroutine getCWD_C
subroutine getHostName_C(hostname, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
use prec
character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: hostname ! NULL-terminated array
integer(C_INT), intent(out) :: stat
end subroutine getHostName_C
function chdir_C(path) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_INT, &
C_CHAR
subroutine getUserName_C(username, stat) bind(C)
use, intrinsic :: ISO_C_Binding, only: C_INT, C_CHAR
use prec
integer(C_INT) :: chdir_C
character(kind=C_CHAR), dimension(pPathLen), intent(in) :: path ! C string is an array
end function chdir_C
character(kind=C_CHAR), dimension(pStringLen+1), intent(out) :: username ! NULL-terminated array
integer(C_INT), intent(out) :: stat
end subroutine getUserName_C
subroutine signalterm_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR
use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalterm_C
subroutine signalusr1_C(handler) bind(C)
use, intrinsic :: ISO_C_Binding, only: &
C_FUNPTR
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
use, intrinsic :: ISO_C_Binding, only: C_FUNPTR
type(C_FUNPTR), intent(in), value :: handler
end subroutine signalusr2_C
@ -89,45 +75,48 @@ module system_routines
contains
!--------------------------------------------------------------------------------------------------
!> @brief figures out if a given path is a directory (and not an ordinary file)
!> @brief set the current working directory
!--------------------------------------------------------------------------------------------------
logical function isDirectory(path)
logical function setCWD(path)
character(len=*), intent(in) :: path
isDirectory=merge(.True.,.False.,isDirectory_C(f_c_string(path)) /= 0_C_INT)
end function isDirectory
setCWD=merge(.True.,.False.,setCWD_C(f_c_string(path)) /= 0_C_INT)
end function setCWD
!--------------------------------------------------------------------------------------------------
!> @brief gets the current working directory
!> @brief get the current working directory
!--------------------------------------------------------------------------------------------------
function getCWD()
character(kind=C_CHAR), dimension(pPathLen) :: getCWD_Cstring
character(len=:), allocatable :: getCWD
character(len=:), allocatable :: getCWD
character(kind=C_CHAR), dimension(pPathLen+1) :: getCWD_Cstring
integer(C_INT) :: stat
call getCurrentWorkDir_C(getCWD_Cstring,stat)
call getCWD_C(getCWD_Cstring,stat)
if(stat == 0) then
getCWD = c_f_string(getCWD_Cstring)
else
getCWD = 'Error occured when getting currend working directory'
error stop 'invalid working directory'
endif
end function getCWD
!--------------------------------------------------------------------------------------------------
!> @brief gets the current host name
!> @brief get the host name
!--------------------------------------------------------------------------------------------------
function getHostName()
character(kind=C_CHAR), dimension(pPathLen) :: getHostName_Cstring
character(len=:), allocatable :: getHostName
character(len=:), allocatable :: getHostName
character(kind=C_CHAR), dimension(pStringLen+1) :: getHostName_Cstring
integer(C_INT) :: stat
call getHostName_C(getHostName_Cstring,stat)
@ -135,22 +124,31 @@ function getHostName()
if(stat == 0) then
getHostName = c_f_string(getHostName_Cstring)
else
getHostName = 'Error occured when getting host name'
getHostName = 'n/a (Error!)'
endif
end function getHostName
!--------------------------------------------------------------------------------------------------
!> @brief changes the current working directory
!> @brief get the user name
!--------------------------------------------------------------------------------------------------
logical function setCWD(path)
function getUserName()
character(len=*), intent(in) :: path
character(len=:), allocatable :: getUserName
setCWD=merge(.True.,.False.,chdir_C(f_c_string(path)) /= 0_C_INT)
character(kind=C_CHAR), dimension(pStringLen+1) :: getUserName_Cstring
integer(C_INT) :: stat
end function setCWD
call getUserName_C(getUserName_Cstring,stat)
if(stat == 0) then
getUserName = c_f_string(getUserName_Cstring)
else
getUserName = 'n/a (Error!)'
endif
end function getUserName
!--------------------------------------------------------------------------------------------------
@ -182,14 +180,14 @@ end function c_f_string
!--------------------------------------------------------------------------------------------------
pure function f_c_string(f_string) result(c_string)
character(len=*), intent(in) :: f_string
character(kind=C_CHAR), dimension(len(f_string)+1) :: c_string
character(len=*), intent(in) :: f_string
character(kind=C_CHAR), dimension(len_trim(f_string)+1) :: c_string
integer :: i
do i=1,len(f_string)
do i=1,len_trim(f_string)
c_string(i)=f_string(i:i)
enddo
c_string(i) = C_NULL_CHAR
c_string(len_trim(f_string)+1) = C_NULL_CHAR
end function f_c_string