Merge branch 'development' into 53-separate-mesh-for-different-solvers-3

This commit is contained in:
Martin Diehl 2019-02-16 10:25:42 +01:00
commit af83427e8c
30 changed files with 1111 additions and 2277 deletions

View File

@ -7,9 +7,9 @@ stages:
- compilePETScGNU - compilePETScGNU
- prepareSpectral - prepareSpectral
- spectral - spectral
- compileMarc2018_1 - compileMarc
- marc - marc
- compileAbaqus2017 - compileAbaqus
- example - example
- performance - performance
- createPackage - createPackage
@ -51,39 +51,37 @@ variables:
# Names of module files to load # Names of module files to load
# =============================================================================================== # ===============================================================================================
# ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++
IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016"
IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" IntelCompiler17_8: "Compiler/Intel/17.8 Libraries/IMKL/2017"
IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" IntelCompiler18_4: "Compiler/Intel/18.4 Libraries/IMKL/2018"
IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" GNUCompiler8_2: "Compiler/GNU/8.2"
GNUCompiler7_3: "Compiler/GNU/7.3"
# ------------ Defaults ---------------------------------------------- # ------------ Defaults ----------------------------------------------
IntelCompiler: "$IntelCompiler18_1" IntelCompiler: "$IntelCompiler18_4"
GNUCompiler: "$GNUCompiler7_3" GNUCompiler: "$GNUCompiler8_2"
# ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ MPI +++++++++++++++++++++++++++++++++++++++++++++++++++
MPICH3_2Intel18_1: "MPI/Intel/18.1/MPICH/3.2.1" IMPI2018Intel18_4: "MPI/Intel/18.4/IntelMPI/2018"
MPICH3_2GNU7_3: "MPI/GNU/7.3/MPICH/3.2.1" MPICH3_3GNU8_2: "MPI/GNU/8.2/MPICH/3.3"
# ------------ Defaults ---------------------------------------------- # ------------ Defaults ----------------------------------------------
MPICH_Intel: "$MPICH3_2Intel18_1" MPICH_Intel: "$IMPI2018Intel18_4"
MPICH_GNU: "$MPICH3_2GNU7_3" MPICH_GNU: "$MPICH3_3GNU8_2"
# ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ PETSc +++++++++++++++++++++++++++++++++++++++++++++++++
PETSc3_10_0MPICH3_2Intel18_1: "Libraries/PETSc/3.10.0/Intel-18.1-MPICH-3.2.1" PETSc3_10_3IMPI2018Intel18_4: "Libraries/PETSc/3.10.3/Intel-18.4-IntelMPI-2018"
PETSc3_10_0MPICH3_2GNU7_3: "Libraries/PETSc/3.10.0/GNU-7.3-MPICH-3.2.1" PETSc3_10_3MPICH3_3GNU8_2: "Libraries/PETSc/3.10.3/GNU-8.2-MPICH-3.3"
# ------------ Defaults ---------------------------------------------- # ------------ Defaults ----------------------------------------------
PETSc_MPICH_Intel: "$PETSc3_10_0MPICH3_2Intel18_1" PETSc_MPICH_Intel: "$PETSc3_10_3IMPI2018Intel18_4"
PETSc_MPICH_GNU: "$PETSc3_10_0MPICH3_2GNU7_3" PETSc_MPICH_GNU: "$PETSc3_10_3MPICH3_3GNU8_2"
# ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ FEM +++++++++++++++++++++++++++++++++++++++++++++++++++
Abaqus2017: "FEM/Abaqus/2017" Abaqus2019: "FEM/Abaqus/2019"
MSC2018_1: "FEM/MSC/2018.1" MSC2018_1: "FEM/MSC/2018.1"
MSC2017: "FEM/MSC/2017"
# ------------ Defaults ---------------------------------------------- # ------------ Defaults ----------------------------------------------
Abaqus: "$Abaqus2017" Abaqus: "$Abaqus2019"
MSC: "$MSC2018_1" MSC: "$MSC2018_1"
IntelMarc: "$IntelCompiler17_0" IntelMarc: "$IntelCompiler17_8"
IntelAbaqus: "$IntelCompiler16_4" IntelAbaqus: "$IntelCompiler16_4"
# ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++ # ++++++++++++ Documentation +++++++++++++++++++++++++++++++++++++++++
Doxygen1_8_13: "Documentation/Doxygen/1.8.13" Doxygen1_8_15: "Documentation/Doxygen/1.8.15"
# ------------ Defaults ---------------------------------------------- # ------------ Defaults ----------------------------------------------
Doxygen: "$Doxygen1_8_13" Doxygen: "$Doxygen1_8_15"
################################################################################################### ###################################################################################################
@ -158,6 +156,13 @@ Post_AverageDown:
- master - master
- release - release
Post_ASCIItable:
stage: postprocessing
script: ASCIItable/test.py
except:
- master
- release
Post_General: Post_General:
stage: postprocessing stage: postprocessing
script: PostProcessing/test.py script: PostProcessing/test.py
@ -383,9 +388,9 @@ TextureComponents:
################################################################################################### ###################################################################################################
Marc_compileIfort2018_1: Marc_compileIfort2018_1:
stage: compileMarc2018_1 stage: compileMarc
script: script:
- module load $IntelCompiler17_0 $MSC2018_1 - module load $IntelMarc $MSC
- Marc_compileIfort/test.py -m 2018.1 - Marc_compileIfort/test.py -m 2018.1
except: except:
- master - master
@ -430,11 +435,11 @@ J2_plasticBehavior:
- release - release
################################################################################################### ###################################################################################################
Abaqus_compile2017: Abaqus_compile:
stage: compileAbaqus2017 stage: compileAbaqus
script: script:
- module load $IntelCompiler16_4 $Abaqus2017 - module load $IntelAbaqus $Abaqus
- Abaqus_compileIfort/test.py -a 2017 - Abaqus_compileIfort/test.py
except: except:
- master - master
- release - release

View File

@ -445,6 +445,33 @@ elseif(CMAKE_Fortran_COMPILER_ID STREQUAL "GNU")
# Additional options # 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) # -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 () else ()
message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized") message (FATAL_ERROR "Compiler type (CMAKE_Fortran_COMPILER_ID) not recognized")
endif () endif ()

2
CONFIG
View File

@ -8,6 +8,6 @@ set DAMASK_NUM_THREADS = 4
set MSC_ROOT = /opt/msc set MSC_ROOT = /opt/msc
set MARC_VERSION = 2018.1 set MARC_VERSION = 2018.1
set ABAQUS_VERSION = 2017 set ABAQUS_VERSION = 2019
set DAMASK_HDF5 = OFF set DAMASK_HDF5 = OFF

@ -1 +1 @@
Subproject commit beb9682fff7d4d6c65aba12ffd04c7441dc6ba6b Subproject commit 18ba1ba6a5e9ba446dc9311acf2acf2781614db1

1
README
View File

@ -10,3 +10,4 @@ Germany
Email: DAMASK@mpie.de Email: DAMASK@mpie.de
https://damask.mpie.de https://damask.mpie.de
https://magit1.mpie.de

View File

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

View File

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

View File

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

View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7 #!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*- # -*- coding: UTF-8 no BOM -*-
import os,sys import os,sys
@ -21,7 +21,7 @@ Add data of selected column(s) from (first) row of linked ASCIItable that shares
parser.add_option('--link', parser.add_option('--link',
dest = 'link', nargs = 2, dest = 'link', nargs = 2,
type = 'string', metavar = 'string string', type = 'string', metavar = 'string string',
help = 'column labels containing linked values') help = 'column labels of table and linked table containing linking values')
parser.add_option('-l','--label', parser.add_option('-l','--label',
dest = 'label', dest = 'label',
action = 'extend', metavar = '<string LIST>', action = 'extend', metavar = '<string LIST>',
@ -105,7 +105,8 @@ for name in filenames:
outputAlive = True outputAlive = True
while outputAlive and table.data_read(): # read next data line of ASCII table while outputAlive and table.data_read(): # read next data line of ASCII table
try: try:
table.data_append(data[np.argwhere(np.all((map(float,table.data[myLink:myLink+myLinkDim]) - index)==0,axis=1))[0]]) # add data of first matching line table.data_append(data[np.argwhere(np.all((list(map(float,table.data[myLink:myLink+myLinkDim])) - index)==0,
axis=1))[0]]) # add data of first matching line
except IndexError: except IndexError:
table.data_append(np.nan*np.ones_like(data[0])) # or add NaNs table.data_append(np.nan*np.ones_like(data[0])) # or add NaNs
outputAlive = table.data_write() # output processed line outputAlive = table.data_write() # output processed line

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7 #!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*- # -*- coding: UTF-8 no BOM -*-
import os,sys,math import os,sys,math
@ -49,7 +49,7 @@ parser.set_defaults(d = 1,
(options, filenames) = parser.parse_args() (options, filenames) = parser.parse_args()
options.immutable = map(int,options.immutable) options.immutable = list(map(int,options.immutable))
getInterfaceEnergy = lambda A,B: np.float32((A*B != 0)*(A != B)*1.0) # 1.0 if A & B are distinct & nonzero, 0.0 otherwise getInterfaceEnergy = lambda A,B: np.float32((A*B != 0)*(A != B)*1.0) # 1.0 if A & B are distinct & nonzero, 0.0 otherwise
struc = ndimage.generate_binary_structure(3,1) # 3D von Neumann neighborhood struc = ndimage.generate_binary_structure(3,1) # 3D von Neumann neighborhood
@ -70,9 +70,9 @@ for name in filenames:
table.head_read() table.head_read()
info,extra_header = table.head_getGeom() info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: {}'.format(' x '.join(map(str,info['grid']))), damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))),
'size x y z: {}'.format(' x '.join(map(str,info['size']))), 'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))),
'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization: {}'.format(info['homogenization']), 'homogenization: {}'.format(info['homogenization']),
'microstructures: {}'.format(info['microstructures']), 'microstructures: {}'.format(info['microstructures']),
]) ])
@ -102,9 +102,9 @@ for name in filenames:
gauss = np.exp(-(X*X + Y*Y + Z*Z)/(2.0*options.d*options.d),dtype=np.float32) \ gauss = np.exp(-(X*X + Y*Y + Z*Z)/(2.0*options.d*options.d),dtype=np.float32) \
/np.power(2.0*np.pi*options.d*options.d,(3.0 - np.count_nonzero(info['grid'] == 1))/2.,dtype=np.float32) /np.power(2.0*np.pi*options.d*options.d,(3.0 - np.count_nonzero(info['grid'] == 1))/2.,dtype=np.float32)
gauss[:,:,:grid[2]/2:-1] = gauss[:,:,1:(grid[2]+1)/2] # trying to cope with uneven (odd) grid size gauss[:,:,:grid[2]//2:-1] = gauss[:,:,1:(grid[2]+1)//2] # trying to cope with uneven (odd) grid size
gauss[:,:grid[1]/2:-1,:] = gauss[:,1:(grid[1]+1)/2,:] gauss[:,:grid[1]//2:-1,:] = gauss[:,1:(grid[1]+1)//2,:]
gauss[:grid[0]/2:-1,:,:] = gauss[1:(grid[0]+1)/2,:,:] gauss[:grid[0]//2:-1,:,:] = gauss[1:(grid[0]+1)//2,:,:]
gauss = np.fft.rfftn(gauss).astype(np.complex64) gauss = np.fft.rfftn(gauss).astype(np.complex64)
for smoothIter in range(options.N): for smoothIter in range(options.N):
@ -119,9 +119,9 @@ for name in filenames:
microstructure,i,axis=0), j,axis=1), k,axis=2))) microstructure,i,axis=0), j,axis=1), k,axis=2)))
# periodically extend interfacial energy array by half a grid size in positive and negative directions # periodically extend interfacial energy array by half a grid size in positive and negative directions
periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, periodic_interfaceEnergy = np.tile(interfaceEnergy,(3,3,3))[grid[0]//2:-grid[0]//2,
grid[1]/2:-grid[1]/2, grid[1]//2:-grid[1]//2,
grid[2]/2:-grid[2]/2] grid[2]//2:-grid[2]//2]
# transform bulk volume (i.e. where interfacial energy remained zero), store index of closest boundary voxel # transform bulk volume (i.e. where interfacial energy remained zero), store index of closest boundary voxel
index = ndimage.morphology.distance_transform_edt(periodic_interfaceEnergy == 0., index = ndimage.morphology.distance_transform_edt(periodic_interfaceEnergy == 0.,
@ -148,15 +148,15 @@ for name in filenames:
ndimage.morphology.binary_dilation(interfaceEnergy > 0., ndimage.morphology.binary_dilation(interfaceEnergy > 0.,
structure = struc, structure = struc,
iterations = int(round(options.d*2.))-1),# fat boundary iterations = int(round(options.d*2.))-1),# fat boundary
periodic_bulkEnergy[grid[0]/2:-grid[0]/2, # retain filled energy on fat boundary... periodic_bulkEnergy[grid[0]//2:-grid[0]//2, # retain filled energy on fat boundary...
grid[1]/2:-grid[1]/2, grid[1]//2:-grid[1]//2,
grid[2]/2:-grid[2]/2], # ...and zero everywhere else grid[2]//2:-grid[2]//2], # ...and zero everywhere else
0.)).astype(np.complex64) * 0.)).astype(np.complex64) *
gauss).astype(np.float32) gauss).astype(np.float32)
periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]/2:-grid[0]/2, periodic_diffusedEnergy = np.tile(diffusedEnergy,(3,3,3))[grid[0]//2:-grid[0]//2,
grid[1]/2:-grid[1]/2, grid[1]//2:-grid[1]//2,
grid[2]/2:-grid[2]/2] # periodically extend the smoothed bulk energy grid[2]//2:-grid[2]//2] # periodically extend the smoothed bulk energy
# transform voxels close to interface region # transform voxels close to interface region
@ -164,15 +164,15 @@ for name in filenames:
return_distances = False, return_distances = False,
return_indices = True) # want index of closest bulk grain return_indices = True) # want index of closest bulk grain
periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]/2:-grid[0]/2, periodic_microstructure = np.tile(microstructure,(3,3,3))[grid[0]//2:-grid[0]//2,
grid[1]/2:-grid[1]/2, grid[1]//2:-grid[1]//2,
grid[2]/2:-grid[2]/2] # periodically extend the microstructure grid[2]//2:-grid[2]//2] # periodically extend the microstructure
microstructure = periodic_microstructure[index[0], microstructure = periodic_microstructure[index[0],
index[1], index[1],
index[2]].reshape(2*grid)[grid[0]/2:-grid[0]/2, index[2]].reshape(2*grid)[grid[0]//2:-grid[0]//2,
grid[1]/2:-grid[1]/2, grid[1]//2:-grid[1]//2,
grid[2]/2:-grid[2]/2] # extent grains into interface region grid[2]//2:-grid[2]//2] # extent grains into interface region
# replace immutable microstructures with closest mutable ones # replace immutable microstructures with closest mutable ones
index = ndimage.morphology.distance_transform_edt(np.in1d(microstructure,options.immutable).reshape(grid), index = ndimage.morphology.distance_transform_edt(np.in1d(microstructure,options.immutable).reshape(grid),
@ -236,3 +236,4 @@ for name in filenames:
# --- output finalization -------------------------------------------------------------------------- # --- output finalization --------------------------------------------------------------------------
table.close() table.close()

View File

@ -1,4 +1,4 @@
#!/usr/bin/env python2.7 #!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*- # -*- coding: UTF-8 no BOM -*-
import os,sys import os,sys
@ -48,11 +48,11 @@ for name in filenames:
table.head_read() table.head_read()
info,extra_header = table.head_getGeom() info,extra_header = table.head_getGeom()
damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), damask.util.croak(['grid a b c: {}'.format(' x '.join(list(map(str,info['grid'])))),
'size x y z: %s'%(' x '.join(map(str,info['size']))), 'size x y z: {}'.format(' x '.join(list(map(str,info['size'])))),
'origin x y z: %s'%(' : '.join(map(str,info['origin']))), 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))),
'homogenization: %i'%info['homogenization'], 'homogenization: {}'.format(info['homogenization']),
'microstructures: %i'%info['microstructures'], 'microstructures: {}'.format(info['microstructures']),
]) ])
errors = [] errors = []

View File

@ -1,10 +1,11 @@
#!/usr/bin/env python2.7 #!/usr/bin/env python3
# -*- coding: UTF-8 no BOM -*- # -*- coding: UTF-8 no BOM -*-
import threading,time,os,sys,random import threading,time,os,sys,random
import numpy as np import numpy as np
from optparse import OptionParser from optparse import OptionParser
from cStringIO import StringIO from io import StringIO
import binascii
import damask import damask
scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptName = os.path.splitext(os.path.basename(__file__))[0]
@ -96,7 +97,7 @@ class myThread (threading.Thread):
perturbedGeomVFile = StringIO() perturbedGeomVFile = StringIO()
perturbedSeedsVFile.reset() perturbedSeedsVFile.reset()
perturbedGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ perturbedGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+
' -g '+' '.join(map(str, options.grid)),streamIn=perturbedSeedsVFile)[0]) ' -g '+' '.join(list(map(str, options.grid))),streamIn=perturbedSeedsVFile)[0])
perturbedGeomVFile.reset() perturbedGeomVFile.reset()
#--- evaluate current seeds file ---------------------------------------------------------------------- #--- evaluate current seeds file ----------------------------------------------------------------------
@ -214,7 +215,7 @@ options = parser.parse_args()[0]
damask.util.report(scriptName,options.seedFile) damask.util.report(scriptName,options.seedFile)
if options.randomSeed is None: if options.randomSeed is None:
options.randomSeed = int(os.urandom(4).encode('hex'), 16) options.randomSeed = int(binascii.hexlify(os.urandom(4)),16)
damask.util.croak(options.randomSeed) damask.util.croak(options.randomSeed)
delta = (options.scale/options.grid[0],options.scale/options.grid[1],options.scale/options.grid[2]) delta = (options.scale/options.grid[0],options.scale/options.grid[1],options.scale/options.grid[2])
baseFile=os.path.splitext(os.path.basename(options.seedFile))[0] baseFile=os.path.splitext(os.path.basename(options.seedFile))[0]
@ -240,17 +241,17 @@ if os.path.isfile(os.path.splitext(options.seedFile)[0]+'.seeds'):
for line in initialSeedFile: bestSeedsVFile.write(line) for line in initialSeedFile: bestSeedsVFile.write(line)
else: else:
bestSeedsVFile.write(damask.util.execute('seeds_fromRandom'+\ bestSeedsVFile.write(damask.util.execute('seeds_fromRandom'+\
' -g '+' '.join(map(str, options.grid))+\ ' -g '+' '.join(list(map(str, options.grid)))+\
' -r {:d}'.format(options.randomSeed)+\ ' -r {:d}'.format(options.randomSeed)+\
' -N '+str(nMicrostructures))[0]) ' -N '+str(nMicrostructures))[0])
bestSeedsUpdate = time.time() bestSeedsUpdate = time.time()
# ----------- tessellate initial seed file to get and evaluate geom file # ----------- tessellate initial seed file to get and evaluate geom file
bestSeedsVFile.reset() bestSeedsVFile.seek(0)
initialGeomVFile = StringIO() initialGeomVFile = StringIO()
initialGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+ initialGeomVFile.write(damask.util.execute('geom_fromVoronoiTessellation '+
' -g '+' '.join(map(str, options.grid)),bestSeedsVFile)[0]) ' -g '+' '.join(list(map(str, options.grid))),bestSeedsVFile)[0])
initialGeomVFile.reset() initialGeomVFile.seek(0)
initialGeomTable = damask.ASCIItable(initialGeomVFile,None,labeled=False,readonly=True) initialGeomTable = damask.ASCIItable(initialGeomVFile,None,labeled=False,readonly=True)
initialGeomTable.head_read() initialGeomTable.head_read()
info,devNull = initialGeomTable.head_getGeom() info,devNull = initialGeomTable.head_getGeom()

View File

@ -2,7 +2,7 @@
from .solver import Solver from .solver import Solver
import damask import damask
import subprocess,re import subprocess
class Abaqus(Solver): class Abaqus(Solver):
@ -15,14 +15,13 @@ class Abaqus(Solver):
def return_run_command(self,model): def return_run_command(self,model):
env=damask.Environment() env=damask.Environment()
shortVersion = re.sub('[\.,-]', '',self.version)
try: try:
cmd='abq'+shortVersion cmd='abq'+self.version
subprocess.check_output(['abq'+shortVersion,'information=release']) subprocess.check_output([cmd,'information=release'])
except OSError: # link to abqXXX not existing except OSError: # link to abqXXX not existing
cmd='abaqus' cmd='abaqus'
process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE) process = subprocess.Popen(['abaqus','information=release'],stdout = subprocess.PIPE,stderr = subprocess.PIPE)
detectedVersion = process.stdout.readlines()[1].split()[1] detectedVersion = process.stdout.readlines()[1].split()[1].decode('utf-8')
if self.version != detectedVersion: if self.version != detectedVersion:
raise Exception('found Abaqus version %s, but requested %s'%(detectedVersion,self.version)) raise Exception('found Abaqus version {}, but requested {}'.format(detectedVersion,self.version))
return '%s -job %s -user %s/src/DAMASK_abaqus interactive'%(cmd,model,env.rootDir()) return '{} -job {} -user {}/src/DAMASK_abaqus interactive'.format(cmd,model,env.rootDir())

View File

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

View File

@ -40,16 +40,25 @@ subroutine DAMASK_interface_init
character(len=256) :: wd character(len=256) :: wd
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',& write(6,'(a,/)') ' Version: '//DAMASKVERSION
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
dateAndTime(6),':',& #if __INTEL_COMPILER >= 1800
dateAndTime(7) write(6,*) 'Compiled with: ', compiler_version()
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,*) 'Compiler options: ', compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
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)
call getoutdir(wd, lenOutDir) call getoutdir(wd, lenOutDir)
ierr = CHDIR(wd) ierr = CHDIR(wd)

View File

@ -12,9 +12,9 @@
module DAMASK_interface module DAMASK_interface
use prec, only: & use prec, only: &
pInt pInt
implicit none implicit none
private private
logical, public, protected :: SIGUSR1,SIGUSR2
integer(pInt), public, protected :: & integer(pInt), public, protected :: &
interface_restartInc = 0_pInt !< Increment at which calculation starts interface_restartInc = 0_pInt !< Increment at which calculation starts
character(len=1024), public, protected :: & character(len=1024), public, protected :: &
@ -42,6 +42,8 @@ contains
subroutine DAMASK_interface_init() subroutine DAMASK_interface_init()
use, intrinsic :: & use, intrinsic :: &
iso_fortran_env iso_fortran_env
use :: &
iso_c_binding
#include <petsc/finclude/petscsys.h> #include <petsc/finclude/petscsys.h>
#if defined(__GFORTRAN__) && __GNUC__ < 5 #if defined(__GFORTRAN__) && __GNUC__ < 5
=================================================================================================== ===================================================================================================
@ -81,6 +83,8 @@ subroutine DAMASK_interface_init()
use PETScSys use PETScSys
use system_routines, only: & use system_routines, only: &
signalusr1_C, &
signalusr2_C, &
getHostName, & getHostName, &
getCWD getCWD
@ -139,16 +143,27 @@ subroutine DAMASK_interface_init()
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',& write(6,'(a,/)') ' Version: '//DAMASKVERSION
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
dateAndTime(6),':',& #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
dateAndTime(7) write(6,*) 'Compiled with: ', compiler_version()
write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize write(6,*) 'Compiler options: ', compiler_options()
#include "compilation_info.f90" #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,'(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)
call get_command(commandLine) call get_command(commandLine)
chunkPos = IIO_stringPos(commandLine) chunkPos = IIO_stringPos(commandLine)
@ -215,9 +230,11 @@ subroutine DAMASK_interface_init()
call get_environment_variable('USER',userName) call get_environment_variable('USER',userName)
! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux ! ToDo: https://stackoverflow.com/questions/8953424/how-to-get-the-username-in-c-c-in-linux
write(6,'(a,a)') ' Host name: ', trim(getHostName()) write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize
write(6,'(a,a)') ' User name: ', trim(userName) write(6,'(a,a)') ' Host name: ', trim(getHostName())
write(6,'(a,a)') ' Command line call: ', trim(commandLine) write(6,'(a,a)') ' User name: ', trim(userName)
write(6,'(/a,a)') ' Command line call: ', trim(commandLine)
if (len(trim(workingDirArg)) > 0) & if (len(trim(workingDirArg)) > 0) &
write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg)
write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg)
@ -229,6 +246,12 @@ subroutine DAMASK_interface_init()
if (interface_restartInc > 0_pInt) & if (interface_restartInc > 0_pInt) &
write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc 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 end subroutine DAMASK_interface_init
@ -412,6 +435,35 @@ character(len=1024) function makeRelativePath(a,b)
end function makeRelativePath 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 !> @brief taken from IO, check IO_stringValue for documentation
@ -469,7 +521,6 @@ pure function IIO_stringPos(string)
do while (verify(string(right+1:),SEP)>0) do while (verify(string(right+1:),SEP)>0)
left = right + verify(string(right+1:),SEP) left = right + verify(string(right+1:),SEP)
right = left + scan(string(left:),SEP) - 2 right = left + scan(string(left:),SEP) - 2
if ( string(left:left) == '#' ) exit
IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)] IIO_stringPos = [IIO_stringPos,int(left, pInt), int(right, pInt)]
IIO_stringPos(1) = IIO_stringPos(1)+1_pInt IIO_stringPos(1) = IIO_stringPos(1)+1_pInt
enddo enddo

View File

@ -53,17 +53,26 @@ subroutine DAMASK_interface_init
character(len=1024) :: wd character(len=1024) :: wd
call date_and_time(values = dateAndTime) call date_and_time(values = dateAndTime)
write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_abaqus -+>>>'
write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Roters et al., Computational Materials Science 158, 2018, 420-478'
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,/)') ' https://doi.org/10.1016/j.commatsci.2018.04.030'
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',& write(6,'(a,/)') ' Version: '//DAMASKVERSION
dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& ! https://github.com/jeffhammond/HPCInfo/blob/master/docs/Preprocessor-Macros.md
dateAndTime(6),':',& #if __INTEL_COMPILER >= 1800
dateAndTime(7) write(6,*) 'Compiled with: ', compiler_version()
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,*) 'Compiler options: ', compiler_options()
#include "compilation_info.f90" #else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version :', __INTEL_COMPILER,&
', build date :', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
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)
inquire(5, name=wd) ! determine inputputfile inquire(5, name=wd) ! determine inputputfile
wd = wd(1:scan(wd,'/',back=.true.)) wd = wd(1:scan(wd,'/',back=.true.))
ierr = CHDIR(wd) ierr = CHDIR(wd)

View File

@ -162,7 +162,6 @@ subroutine utilities_init()
character(len=1024) :: petsc_optionsPhysics character(len=1024) :: petsc_optionsPhysics
integer(pInt) :: dimPlex integer(pInt) :: dimPlex
integer(pInt) :: headerID = 205_pInt
PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:) PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:)
PetscInt :: dim PetscInt :: dim
PetscErrorCode :: ierr PetscErrorCode :: ierr
@ -213,13 +212,6 @@ subroutine utilities_init()
nOutputCells(worldrank+1) = count(material_homog > 0_pInt) 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,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) 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 end subroutine utilities_init

File diff suppressed because it is too large Load Diff

View File

@ -1,10 +0,0 @@
#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800
write(6,*) 'Compiled with ', compiler_version()
write(6,*) 'With options ', compiler_options()
#else
write(6,'(a,i4.4,a,i8.8)') ' Compiled with Intel fortran version ', __INTEL_COMPILER,&
', build date ', __INTEL_COMPILER_BUILD_DATE
#endif
write(6,*) 'Compiled on ', __DATE__,' at ',__TIME__
write(6,*)
flush(6)

View File

@ -24,10 +24,10 @@ module kinematics_thermal_expansion
integer(pInt), dimension(:), allocatable, target, public :: & integer(pInt), dimension(:), allocatable, target, public :: &
kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage kinematics_thermal_expansion_Noutput !< number of outputs per instance of this damage
! enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult enum, bind(c) ! ToDo kinematics need state machinery to deal with sizePostResult
! enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output enumerator :: undefined_ID, & ! possible remedy is to decouple having state vars from having output
! thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput... thermalexpansionrate_ID ! which means to separate user-defined types tState + tOutput...
! end enum end enum
public :: & public :: &
kinematics_thermal_expansion_init, & kinematics_thermal_expansion_init, &
kinematics_thermal_expansion_initialStrain, & kinematics_thermal_expansion_initialStrain, &

View File

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

View File

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