diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 0721f1374..2d65f53a7 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -3,8 +3,8 @@ stages: - prepareAll - preprocessing - postprocessing - - compileSpectralIntel - - compileSpectralGNU + - compilePETScIntel + - compilePETScGNU - prepareSpectral - spectral - compileMarc2017 @@ -29,6 +29,11 @@ before_script: done - source $DAMASKROOT/env/DAMASK.sh - cd $DAMASKROOT/PRIVATE/testing + - echo Job start:" $(date)" + +################################################################################################### +after_script: + - echo Job end:" $(date)" ################################################################################################### variables: @@ -47,6 +52,7 @@ variables: # =============================================================================================== # ++++++++++++ Compiler ++++++++++++++++++++++++++++++++++++++++++++++ IntelCompiler16_0: "Compiler/Intel/16.0 Libraries/IMKL/2016" + IntelCompiler16_4: "Compiler/Intel/16.4 Libraries/IMKL/2016-4" IntelCompiler17_0: "Compiler/Intel/17.0 Libraries/IMKL/2017" IntelCompiler18_1: "Compiler/Intel/18.1 Libraries/IMKL/2018" GNUCompiler7_3: "Compiler/GNU/7.3" @@ -186,8 +192,8 @@ Post_ParaviewRelated: - release ################################################################################################### -Compile_Intel: - stage: compileSpectralIntel +Compile_Spectral_Intel: + stage: compilePETScIntel script: - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel - SpectralAll_compile/test.py @@ -195,9 +201,18 @@ Compile_Intel: - master - release +Compile_FEM_Intel: + stage: compilePETScIntel + script: + - module load $IntelCompiler $MPICH_Intel $PETSc_MPICH_Intel + - FEM_compile/test.py + except: + - master + - release + ################################################################################################### -Compile_GNU: - stage: compileSpectralGNU +Compile_Spectral_GNU: + stage: compilePETScGNU script: - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU - SpectralAll_compile/test.py @@ -205,6 +220,15 @@ Compile_GNU: - master - release +Compile_FEM_GNU: + stage: compilePETScGNU + script: + - module load $GNUCompiler $MPICH_GNU $PETSc_MPICH_GNU + - FEM_compile/test.py + except: + - master + - release + ################################################################################################### Compile_Intel_Prepare: stage: prepareSpectral @@ -329,7 +353,7 @@ TextureComponents: Marc_compileIfort2017: stage: compileMarc2017 script: - - module load $IntelCompiler17_0 $MSC2017 + - module load $IntelCompiler16_4 $MSC2017 - Marc_compileIfort/test.py -m 2017 except: - master @@ -339,7 +363,7 @@ Marc_compileIfort2017: Hex_elastic: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - Hex_elastic/test.py except: - master @@ -348,7 +372,7 @@ Hex_elastic: CubicFCC_elastic: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - CubicFCC_elastic/test.py except: - master @@ -357,7 +381,7 @@ CubicFCC_elastic: CubicBCC_elastic: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - CubicBCC_elastic/test.py except: - master @@ -366,7 +390,7 @@ CubicBCC_elastic: J2_plasticBehavior: stage: marc script: - - module load $IntelCompiler17_0 $MSC + - module load $IntelCompiler16_4 $MSC - J2_plasticBehavior/test.py except: - master @@ -376,7 +400,7 @@ J2_plasticBehavior: Abaqus_compile2017: stage: compileAbaqus2017 script: - - module load $IntelCompiler16_0 $Abaqus2017 + - module load $IntelCompiler16_4 $Abaqus2017 - Abaqus_compileIfort/test.py -a 2017 except: - master @@ -392,7 +416,7 @@ SpectralExample: AbaqusExample: stage: example script: - - module load $IntelCompiler16_0 $Abaqus + - module load $IntelCompiler16_4 $Abaqus - Abaqus_example/test.py only: - development @@ -418,6 +442,9 @@ createTar: script: - cd $(mktemp -d) - $DAMASKROOT/PRIVATE/releasing/deployMe.sh $CI_COMMIT_SHA + except: + - master + - release ################################################################################################### AbaqusStd: diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 4877d4b22..b5acede32 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -12,21 +12,38 @@ echo + Send to damask@mpie.de for support echo + view with \'cat $OUTFILE\' echo =========================================== +function firstLevel { +echo -e '\n\n==============================================================================================' +echo $1 +echo ============================================================================================== +} + +function secondLevel { +echo ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +echo $1 +echo ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ +} + +function thirdLevel { +echo -e '\n----------------------------------------------------------------------------------------------' +echo $1 +echo ---------------------------------------------------------------------------------------------- +} + function getDetails { if which $1 &> /dev/null; then - echo ---------------------------------------------------------------------------------------------- - echo $1: - echo ---------------------------------------------------------------------------------------------- + secondLevel $1: echo + location: which $1 echo + $1 $2: $1 $2 - echo -e '\n' else echo $1 not found fi +echo } + # redirect STDOUT and STDERR to logfile # https://stackoverflow.com/questions/11229385/redirect-all-output-in-a-bash-script-when-using-set-x^ exec > $OUTFILE 2>&1 @@ -38,28 +55,18 @@ DAMASK_ROOT="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )" echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX echo System report for \'$(hostname)\' created on $(date '+%Y-%m-%d %H:%M:%S') by \'$(whoami)\' echo XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX -echo -echo ============================================================================================== -echo DAMASK settings -echo ============================================================================================== -echo ---------------------------------------------------------------------------------------------- -echo DAMASK_ROOT: -echo ---------------------------------------------------------------------------------------------- + +firstLevel "DAMASK settings" +secondLevel "DAMASK_ROOT" echo $DAMASK_ROOT echo -echo ---------------------------------------------------------------------------------------------- -echo Version: -echo ---------------------------------------------------------------------------------------------- +secondLevel "Version" cat VERSION echo -echo ---------------------------------------------------------------------------------------------- -echo Settings in CONFIG: -echo ---------------------------------------------------------------------------------------------- +secondLevel "Settings in CONFIG" cat CONFIG -echo -echo ============================================================================================== -echo System -echo ============================================================================================== + +firstLevel "System" uname -a echo echo PATH: $PATH @@ -69,74 +76,52 @@ echo SHELL: $SHELL echo PETSC_ARCH: $PETSC_ARCH echo PETSC_DIR: $PETSC_DIR ls $PETSC_DIR/lib -echo -echo ============================================================================================== -echo Python -echo ============================================================================================== +firstLevel "Python" DEFAULT_PYTHON=python2.7 for executable in python python2 python3 python2.7; do getDetails $executable '--version' done -echo ---------------------------------------------------------------------------------------------- -echo Details on $DEFAULT_PYTHON: -echo ---------------------------------------------------------------------------------------------- +secondLevel "Details on $DEFAULT_PYTHON:" echo $(ls -la $(which $DEFAULT_PYTHON)) for module in numpy scipy;do - echo -e '\n----------------------------------------------------------------------------------------------' - echo $module - echo ---------------------------------------------------------------------------------------------- + thirdLevel $module $DEFAULT_PYTHON -c "import $module; \ print('Version: {}'.format($module.__version__)); \ print('Location: {}'.format($module.__file__))" done -echo ---------------------------------------------------------------------------------------------- -echo vtk -echo ---------------------------------------------------------------------------------------------- +thirdLevel vtk $DEFAULT_PYTHON -c "import vtk; \ print('Version: {}'.format(vtk.vtkVersion.GetVTKVersion())); \ print('Location: {}'.format(vtk.__file__))" -echo ---------------------------------------------------------------------------------------------- -echo h5py -echo ---------------------------------------------------------------------------------------------- +thirdLevel h5py $DEFAULT_PYTHON -c "import h5py; \ print('Version: {}'.format(h5py.version.version)); \ print('Location: {}'.format(h5py.__file__))" -echo -echo ============================================================================================== -echo GCC -echo ============================================================================================== + +firstLevel "GNU Compiler Collection" for executable in gcc g++ gfortran ;do getDetails $executable '--version' done -echo -echo ============================================================================================== -echo Intel Compiler Suite -echo ============================================================================================== + +firstLevel "Intel Compiler Suite" for executable in icc icpc ifort ;do getDetails $executable '--version' done -echo -echo ============================================================================================== -echo MPI Wrappers -echo ============================================================================================== + +firstLevel "MPI Wrappers" for executable in mpicc mpiCC mpic++ mpicpc mpicxx mpifort mpif90 mpif77; do getDetails $executable '-show' done -echo -echo ============================================================================================== -echo MPI Launchers -echo ============================================================================================== + +firstLevel "MPI Launchers" for executable in mpirun mpiexec; do getDetails $executable '--version' done -echo -echo ============================================================================================== -echo Abaqus -echo ============================================================================================== + +firstLevel "Abaqus" cd installation/mods_Abaqus # to have the right environment file -for executable in abaqus abq2016 abq2017; do +for executable in abaqus abq2017 abq2018; do getDetails $executable 'information=all' done cd ../.. - diff --git a/PRIVATE b/PRIVATE index 20881ab8e..2c40bb79f 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 20881ab8ebe6e64bac939ef6b2f8eb5168601a71 +Subproject commit 2c40bb79f9a57d2178eb7be0e533fd5104f9f87e diff --git a/VERSION b/VERSION index f889e902a..069730c70 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.2-226-g6ed1e316 +v2.0.2-514-gbfa56e9b diff --git a/env/DAMASK.csh b/env/DAMASK.csh index 26e2dd8a2..07b4b6817 100644 --- a/env/DAMASK.csh +++ b/env/DAMASK.csh @@ -19,7 +19,9 @@ if ( "x$DAMASK_NUM_THREADS" == "x" ) then endif # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit limit datasize unlimited # maximum heap size (kB) limit stacksize unlimited # maximum stack size (kB) diff --git a/env/DAMASK.sh b/env/DAMASK.sh index 509f5f1b7..663e9a4b3 100644 --- a/env/DAMASK.sh +++ b/env/DAMASK.sh @@ -42,7 +42,9 @@ PROCESSING=$(type -p postResults || true 2>/dev/null) [ "x$DAMASK_NUM_THREADS" == "x" ] && DAMASK_NUM_THREADS=1 # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit ulimit -d unlimited 2>/dev/null # maximum heap size (kB) ulimit -s unlimited 2>/dev/null # maximum stack size (kB) diff --git a/env/DAMASK.zsh b/env/DAMASK.zsh index 3ceeb116a..43f682865 100644 --- a/env/DAMASK.zsh +++ b/env/DAMASK.zsh @@ -33,7 +33,9 @@ PROCESSING=$(which postResults || true 2>/dev/null) [ "x$DAMASK_NUM_THREADS" = "x" ] && DAMASK_NUM_THREADS=1 # currently, there is no information that unlimited causes problems -# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# still, http://software.intel.com/en-us/forums/topic/501500 suggest to fix it +# more info https://jblevins.org/log/segfault +# https://stackoverflow.com/questions/79923/what-and-where-are-the-stack-and-heap # http://superuser.com/questions/220059/what-parameters-has-ulimit ulimit -d unlimited 2>/dev/null # maximum heap size (kB) ulimit -s unlimited 2>/dev/null # maximum stack size (kB) diff --git a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config index 6e005f251..c86d516a9 100644 --- a/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config +++ b/examples/ConfigFiles/Phase_Phenopowerlaw_BCC-Martensite.config @@ -18,5 +18,5 @@ tau0_slip 405.8e6 456.7e6 # per family tausat_slip 872.9e6 971.2e6 # per family h0_slipslip 563.0e9 interaction_slipslip 1 1 1.4 1.4 1.4 1.4 -w0_slip 2.0 +a_slip 2.0 (output) totalshear diff --git a/examples/SpectralMethod/EshelbyInclusion/material.config b/examples/SpectralMethod/EshelbyInclusion/material.config index 83045938d..e002584b0 100644 --- a/examples/SpectralMethod/EshelbyInclusion/material.config +++ b/examples/SpectralMethod/EshelbyInclusion/material.config @@ -38,7 +38,7 @@ plasticity none [Ti matrix] lattice_structure hex -covera_ratio 1.587 +c/a 1.587 plasticity none {config/elastic_Ti.config} {config/thermal.config} @@ -65,7 +65,7 @@ plasticity none [Ti inclusion] lattice_structure hex -covera_ratio 1.587 +c/a 1.587 plasticity none {config/elastic_Ti.config} {config/thermal.config} diff --git a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask b/installation/mods_MarcMentat/2016/Marc_tools/comp_damask deleted file mode 100644 index 2d144b8a4..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h b/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h deleted file mode 100644 index 01464f095..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_h +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l b/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l deleted file mode 100644 index 31b5cd175..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/comp_damask_l +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2016/Marc_tools/run_damask b/installation/mods_MarcMentat/2016/Marc_tools/run_damask deleted file mode 100644 index 0fc2e639a..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/run_damask +++ /dev/null @@ -1,4112 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=1 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_h b/installation/mods_MarcMentat/2016/Marc_tools/run_damask_h deleted file mode 100644 index 182b5fc25..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_h +++ /dev/null @@ -1,4112 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=1 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_l b/installation/mods_MarcMentat/2016/Marc_tools/run_damask_l deleted file mode 100644 index 87cd1e5c6..000000000 --- a/installation/mods_MarcMentat/2016/Marc_tools/run_damask_l +++ /dev/null @@ -1,4112 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=1 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/kill7 b/installation/mods_MarcMentat/2016/Mentat_bin/kill7 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/kill7 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/kill8 b/installation/mods_MarcMentat/2016/Mentat_bin/kill8 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/kill8 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/kill9 b/installation/mods_MarcMentat/2016/Mentat_bin/kill9 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/kill9 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/submit7 b/installation/mods_MarcMentat/2016/Mentat_bin/submit7 deleted file mode 100644 index d0e3be475..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/submit7 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_h" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/submit8 b/installation/mods_MarcMentat/2016/Mentat_bin/submit8 deleted file mode 100644 index d466fc6ab..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/submit8 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2016/Mentat_bin/submit9 b/installation/mods_MarcMentat/2016/Mentat_bin/submit9 deleted file mode 100644 index 207a61803..000000000 --- a/installation/mods_MarcMentat/2016/Mentat_bin/submit9 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_l" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask b/installation/mods_MarcMentat/2017/Marc_tools/comp_damask deleted file mode 100644 index 2d144b8a4..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h b/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h deleted file mode 100644 index 01464f095..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_h +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l b/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l deleted file mode 100644 index 31b5cd175..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/comp_damask_l +++ /dev/null @@ -1,52 +0,0 @@ -#!/bin/ksh -# 1st arg: $DIR -# 2nd arg: $DIRJOB -# 3rd arg: $user -# 4th arg: $program -DIR=$1 -user=$3 -program=$4 -usernoext=$user -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` -usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - -# add BLAS options for linking - BLAS="%BLAS%" - -. $DIR/tools/include -DIRJOB=$2 -cd $DIRJOB -echo "Compiling and linking user subroutine $user on host `hostname`" -echo "program: $program" - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - userobj=$usernoext.o - - - $LOAD ${program} $DIR/lib/main.o\ - $DIR/lib/blkdta.o $DIR/lib/comm?.o \ - ${userobj-} \ - $DIR/lib/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ../lib/mdsrc.a \ - ../lib/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $BLAS \ - $SYSLIBS || \ - { - echo "$0: link failed for $usernoext.o on host `hostname`" - exit 1 - } - /bin/rm $userobj - /bin/rm $DIRJOB/*.mod diff --git a/installation/mods_MarcMentat/2017/Marc_tools/run_damask b/installation/mods_MarcMentat/2017/Marc_tools/run_damask deleted file mode 100644 index 77977db78..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/run_damask +++ /dev/null @@ -1,4122 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=0 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -nsolverprint=$nsolver -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint -# Update print variable for -nsolver option - nsolverprint=$nsolver - if test $nsolver -eq 0 - then - nsolverprint= - fi - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTRAN $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTRAN $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_h b/installation/mods_MarcMentat/2017/Marc_tools/run_damask_h deleted file mode 100644 index 6247486b9..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_h +++ /dev/null @@ -1,4122 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=0 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -nsolverprint=$nsolver -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint -# Update print variable for -nsolver option - nsolverprint=$nsolver - if test $nsolver -eq 0 - then - nsolverprint= - fi - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_h $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTHIGH $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTHIGH $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_l b/installation/mods_MarcMentat/2017/Marc_tools/run_damask_l deleted file mode 100644 index d159655db..000000000 --- a/installation/mods_MarcMentat/2017/Marc_tools/run_damask_l +++ /dev/null @@ -1,4122 +0,0 @@ -#!/bin/ksh -############################################################################## -# # -# run_marc - run a marc job # -# ------------------------- # -# # -# usage: run_marc -j jid { options } # -# # -# where standard options are: required: defaults: # -# -------------------------- # -# # -# -j* jid job id number. ** YES ** . # -# -pr* prog program name. . marc # -# -v* y|n do or do not verify inputs. . yes # -# -q* s|l|v|b|f batch queue name or background, . short # -# foreground. # -# -b* as alternative to option -q* # -# # -# ( batch queues only : # -# -pq* intra queue priority. . . # -# -at DATE/TIME delay start of job. . . # -# format : January,1,1990,12:31 # -# or : today,5pm # -# -cpu* secs job CPU limit . . ) # -# # -# -r* rid restart file job id. . . # -# -si* sid substructure file id. . . # -# -pi* post post file job id. . . # -# -de* did defaults file . no # -# -vf vid viewfactor . no # -# # -# -u* user user subroutine. . . # -# -obj obj user objects or libraries. . . # -# -sa* y|n do or do not save load module. . no # -# -autorst auto restart flag for auto forge . no # -# -me manual remeshing control . no # -# -ml memory limit in Mbyte # -# -mo This option is deprecated. As of Marc 2015, only # -# the integer*8 version is available. # -# -mpi selects MPI version # -# each platform has a default MPI version and some # -# have an alternative version. see the include file # -# for the respective platform # -# MPI_DEFAULT defines the default MPI version # -# MPI_OTHER defines versions one can switch to # -# -dcoup for contact decoupling # -# currently not supported # -# -dir directory where the job i/o should take place. # -# defaults to current directory. # -# -sdir directory where scratch files are created # -# defaults to current directory. # -# # -# -alloc only perform memory allocation test, no analysis # -# -list y only list options in the input file, no analysis # -# -fe num set feature number "num" for the run. only one allowed # -# -dytran flag to switch from Dytran to Marc # -# dytran = 0, program will run w/o Marc-Dytran Switch # -# = 1, program will restart Marc after Dytran run # -# >= 2, Not supported yet. # -# currently not supported # -# -ou force analysis to use out-of-core control # -# =0, not used # -# =1, element storage out-of-core # -# -dll run marc using shared library libmarc.so and exe_marc # -# =1, used # -# =2, do not free streaming input memory # -# =3, run with marc input deck # -# -trk run marc for post-tracking # -# -gpuid run marc using GPGPU capability # -# specify gpuid on to be used in the analysis. Multiple # -# IDs may be assigned for DDM runs. # -# Separate a list of IDs with a colon. Each DMP # -# process will be assigned a GPU ID in round robin fastion# -# = 0 # -# = 0:1 etc... # -# # -# where parallel options are: # -# -------------------------- # -# # -# itree, host, and comp options are available for the domain # -# decomposition only. # -# MARC_NUMBER_OF_THREADS, nthread, and dir options always available. # -# # -# # -# -nprocd number of domains. # -# defaults to single domain solution. # -# -nprocds number of domains if single input file. # -# defaults to single domain solution. # -# -nps same as -nprocds. # -# -nsolver number of solver tasks for solver types 12 and 13 # -# these are distributed tasks operating via MPI # -# -nthread_elem number of threads for element assembly and recovery # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by element assembly # -# recovery. # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_elem option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_elem specified. # -# -nthread_solver number of threads for solver types 6, 8, and 11 # -# = 0: use defaults. # -# defaults to 1 for single domain solution. # -# defaults to number of domains for multi-domain # -# solution. # -# > 1: number of threads to be used by 6, 8, and 11 # -# Also can be set through MARC_NUMBER_OF_THREADS # -# environment variable. # -# if both specified, -nthread_solver option will be used. # -# defaults if neither MARC_NUMBER_OF_THREADS environment # -# variable set nor -nthread_solver specified. # -# -nthread Same as -nthread_solver. # -# -itree message passing tree type for domain decomposition. # -# for debugging purposes; should not normally be used. # -# -host hostfile name for distributed execution on network. # -# defaults to no hostfile, unless jobid.defhost exists. # -# if jobid.defhost exists, only -np(s) necessary # -# -comp* y|n to be used with user routines on a network of # -# incompatible machines. # -# if set to no, a separate executable will be created # -# for each machine on the network. # -# if set to yes, the executable located on the machine # -# from which marc is started will be used on all machines.# -# defaults to no if O/S versions different on machines. # -# # -# -ci y|n copy input files to remote hosts (default: yes) # -# if "yes", input files are automatically copied to # -# remote hosts for a network run if necessary. # -# -cr y|n copy post files from remote hosts (default: yes) # -# if "yes", post files are automatically copied back from # -# remote hosts for a network run if necessary. # -############################################################################## -# set DIR to the directory in which this script is -REALCOM="`/bin/ls -l $0 |awk '{ print $NF; }'`" -DIR=`dirname $REALCOM` -# make sure DIR has an absolute path -case $DIR in - \/*) - ;; - *) - DIR=`pwd`/$DIR - ;; -esac -DIRSCRIPT=$DIR -AWK=awk -ARCH=`uname -a | cut -f 1 -d " "` -# Sun has a bad awk, use nawk instead -if test $ARCH = "SunOS" -then - AWK=nawk -fi -BASENAME=basename -# Sun has an incorrect /bin/basename, check if /usr/ucb/basename exists -if test $ARCH = "SunOS" -then - if test -x /usr/ucb/basename - then - BASENAME=/usr/ucb/basename - fi -fi - -# echo command line in the case of ECHO_COMMAND is true -if test "$ECHO_COMMAND" = true ; then - echo command "$0" "$@" -fi - -# -# "mode" selects version, i4 or i8 -# default is i4 -# this can be changed by a file run_marc_defaults -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MODE i8 -# it can also be set by the environmental variable MARC_INTEGER_SIZE -# and by the command line option "-mo" -# -mode= -modeerror= -modeoption= -if test -f $DIRSCRIPT/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $DIRSCRIPT/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $DIRSCRIPT/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $DIRSCRIPT/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -f $HOME/run_marc_defaults; then - line=`$AWK '{if ($1 == "MARC_MODE") {print $1}}' $HOME/run_marc_defaults` - if test "$line" = "MARC_MODE"; then - echo - echo warning: the option MARC_MODE is deprecated, as of Marc 2015, only the integer*8 version is available - echo - line= - fi - line=`$AWK '{if ($1 == "MARC_MODE") {print $2}}' $HOME/run_marc_defaults` - line=`echo $line | $AWK '{print $NF}'` - if test "$line" = "i4"; then - modeerror="defaults file $HOME/run_marc_defaults used mode $line ; this must be i8" - modeoption=error - echo $modeerror - fi - if test "$line" = "i8"; then - mode=i8 - fi -fi -if test -n "$MARC_INTEGER_SIZE" ; then - mode=$MARC_INTEGER_SIZE -fi -if test -z "$mode" ; then - mode=i8 -fi -case $mode in - i4) - modeerror="bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - modeoption=error - echo $modeerror - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo "bad value for MARC_INTEGER_SIZE variable; only i8 is supported." - exit - ;; -esac - -setmode=false -for arg in $* ; do - if $setmode ; then - mode=$arg - case $mode in - i4) - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - ;; - i8) - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - ;; - *) - echo " " - echo "error, version mode must be i8" - echo " " - echo " use -mo i8 " - echo " " - exit - ;; - esac - setmode=false - fi - if [ ${arg}X = -moX -o ${arg}X = -MOX ] ; then - echo - echo warning: the option -mo is deprecated, as of Marc 2015, only the integer*8 version is available - echo - setmode=true - fi - if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - MARC_INTEGER_SIZE=i8 - export MARC_INTEGER_SIZE - fi - if [ ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - modeerror="bad value for mode option; only i8 is supported." - modeoption=error - echo - echo $modeerror - echo - fi -done - -# set to i4 version for 32 bit Linux -if test "`uname -s`" = "Linux"; then - if test "`uname -m`" = "i686"; then - mode=i4 - MARC_INTEGER_SIZE=i4 - export MARC_INTEGER_SIZE - fi -fi - - -. "$DIR/getarch" - - -# getting user subroutine file name -found=0 -for i in "$@"; do - if test $found = 1; then - DAMASK_USER=$i - found=0 - fi - case $i in - -u* | -U*) - found=1 - ;; - esac -done -# sourcing include_linux64 (needs DAMASK_USER to be set) -. $MARC_INCLUDE - -# - -# -# Dynamically determine the echo syntax -# - -case "`echo '\c'`" in - '\c') - ECHO='echo -n' - ECHOTXT=' ' - ;; - *) - ECHO='echo' - ECHOTXT=' \c' - ;; -esac - -# -# Variables for the MARC environment -# - -PRODUCT="Marc" -EXITMSG=$MARC_TOOLS/MESSAGES -export EXITMSG -FLEXDIR=$DIR/../flexlm/licenses -export FLEXDIR -TIMCHK=3600 -export TIMCHK -BINDIR=$MARC_BIN -export BINDIR -AFMATDAT=$MARC_RUNTIME/AF_flowmat/ -export AFMATDAT -export MESHERDIR -MSC_LICENSE_FINPROC=0 -export MSC_LICENSE_FINPROC -# -# define directory path to global unified material database -# -MATFILE= -export MATFILE - -# -# define memory limit -# first set to MEMLIMIT from include -# -ml option overrules if specified -memlimit=$MEMLIMIT -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -# -if test $MACHINENAME = "HP" -then - SHLIB_PATH=$MARC_LIB:$MARC_LIB_SHARED:$SHLIB_PATH - export SHLIB_PATH -fi -# the one for IBM is defined futher down - -LD_LIBRARY_PATH=$MARC_LIB_SHARED:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MARC_LIB:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$MESHERDIR:$LD_LIBRARY_PATH -LD_LIBRARY_PATH=$SFMATDIR:$LD_LIBRARY_PATH -LD_LIBRARY64_PATH=$MARC_LIB:$LD_LIBRARY64_PATH -LD_LIBRARYN32_PATH=$MARC_LIB:$LD_LIBRARYN32_PATH -export LD_LIBRARY_PATH -export LD_LIBRARY64_PATH -export LD_LIBRARYN32_PATH - -atexit() { -kill -15 $$ -# -if test $MPITYPE = "myrinet" -then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi -fi -} - -trap "atexit" 2 - -# -# defaults -# - -prog=marc -exefile=marc -jid= -rid= -pid= -sid= -did= -vid= -user= -usernoext= -objs= -qid=background -cpu= -priority= -att= -trk= -verify=yes -prgsav=no -rmdll=no -cpdll=no -progdll= -pathdll= -error= -nprocd=0 -nprocdddm=1 -nprocdddmprint= -icreated=0 -nprocdarg= -nsolver=0 -nsolverarg=-ns -if test $nprocds -then - if test $nprocds -gt 1 - then - nprocdddm=$nprocds - nprocdddmprint=$nprocds - icreated=1 - nprocdarg=-nprocds - fi -fi -ntprint=0 -nt=-1 -nte=-1 -nts=-1 -ntarg=-nt -ntearg=-nte -ntsarg=-nts -nteprint= -ntsprint= -gpuids= -nauto=0 -ndcoup=0 -ndytran=0 -noutcore=0 -dllrun=0 -mesh=0 -itree=0 -iam= -ddm_arc=0 -link= -trkrun=0 -DIRJOB=`pwd` -DIRSCR=$DIRJOB -DIRSCRSET= -autoforge=0 -dotdat=.dat -dotdefhost=.defhost -host= -numhost= -mfile= -userhost= -makebdf= -cpinput=yes -cpresults=yes -marcdll=libmarc.$EXT_DLL -# define hostname and strip off extensions (alpha.aaa.com) -thishost=`hostname` -thishost=${thishost%%.*} -compatible=unknown -numfield=1 -justlist= -feature= -mpioption=false -iprintsimufact= -MDSRCLIB=$MARC_LIB/mdsrc.a -# -# check run_marc_defaults file for default MPI setting -# located in the tools directory of the Marc installation -# or in the user's home directory -# format: -# MARC_MPI -# -value= -file= -if test -f $DIRSCRIPT/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $DIRSCRIPT/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$DIRSCRIPT/run_marc_defaults - fi -fi -if test -f $HOME/run_marc_defaults; then - value=`$AWK '{if ($1 == "MARC_MPI") {print $2}}' $HOME/run_marc_defaults` - value=`echo $value | $AWK '{print $NF}'` - if test -n "$value"; then - file=$HOME/run_marc_defaults - fi -fi -if test -n "$value"; then - MARC_MPITYPE=$value - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - echo " " - echo " error, incorrect option for MARC_MPI" - echo " defined in $file: $MARC_MPITYPE" - echo " valid options: $MPI_DEFAULT $MPI_OTHER" - echo " " - exit - fi - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - fi -fi -# -# -# allow scratch directory to be specified with environmental variable -# MARCSCRATCH -if test $MARCSCRATCH -then - if test -d $MARCSCRATCH - then - DIRSCR=$MARCSCRATCH - else - echo "error, scratch directory '$MARCSCRATCH'" - echo " specified via environmental variable MARCSCRATCH does not exist" - exit - fi -fi -# -############################################################################## -# parse input - arguments always come in pairs # -############################################################################## - -arg=$1 -if [ ${arg}X = -i8X -o ${arg}X = -I8X ] ; then - shift - arg=$1 -fi -while [ -n "$arg" ] -do - shift - value=$1 - case $arg in - -al* | -AL*) - LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - export LD_LIBRARY_PATH - $MARC_BIN/marc -alloc 1 - exit - ;; - -li* | -LI*) - justlist=yes - ;; - -fe* | -FE*) - feature=$value - - ;; - -pr* | -PR*) - if test `dirname $value` = '.' - then - prog=`$BASENAME $value .marc` - progdll=`$BASENAME $value` - else - prog=`dirname $value`/`$BASENAME $value .marc` - progdll=`dirname $value`/`$BASENAME $value` - fi - prdir=`dirname $value` - case $prdir in - \/*) - ;; - *) - prog=`pwd`/$prdir/$prog - ;; - esac - ;; - -j* | -J*) - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - ;; - -r* | -R*) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - -si* | -SI*) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - -pi* | -PI*) - if test -f $value.t19 - then - pid=`$BASENAME $value .t19` - else - pid=`$BASENAME $value .t16` - fi - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - -bdf | -BDF) - makebdf=1 - ;; - -de* | -DE*) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - -vf | -VF) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - -u* | -U*) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - -obj | -OBJ) - objs="$value" - ;; - -q* | -Q*) - qid=$value - ;; - -b* | -B*) - case $value in - y* | Y*) - qid=background - ;; - n* | N*) - qid=foreground - ;; - *) - ;; - esac - ;; - -at | -AT) - att=$value - ;; - -cpu* | -CPU*) - cpu=$value - ;; - -pq | -PQ*) - priority=$value - ;; - -v* | -V*) - verify=$value - ;; - -sa* | -SA*) - prgsav=$value - ;; - -np* | -NP*) - nprocdddm=$value - nprocdddmprint=$value - case $arg in - -nps* | -NPS* | -nprocds* | -NPROCDS*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - case $arg in - -np | -NP | -nprocd | -NPROCD) - icreated=0 - nprocdarg=-nprocd - ;; - esac - ;; - -ns* | -NS*) - nsolver=$value - ;; - -nt* | -NT*) - case $arg in - -nte | -NTE | -nthread_e* | -NTHREAD_E*) - nte=$value - ;; - esac - case $arg in - -nts | -NTS | -nthread_s* | -NTHREAD_S*) - nts=$value - ;; - esac - case $arg in - -nt | -NT | -nth* | -NTH* | -nthread* | -NTHREAD*) - nt=$value - ;; - esac - ;; - -gp* | -GP*) - gpuids=$value - ;; - -it* | -IT*) - itree=$value - ;; - -iam | -IAM) - iam=$value - case $value in - sfg | sfm | sim) - iprintsimufact=true - ;; - esac - ;; - -au* | -AU*) - nauto=$value - ;; - -dc* | -DC*) - ndcoup=$value - ;; - -dy* | -DY*) - ndytran=$value - ;; - -ou* | -OU*) - noutcore=$value - ;; - -dll | -DLL) - dllrun=$value - ;; - -trk | -TRK) - trkrun=$value - ;; - -ddm | -DDM) - ddm_arc=$value - ;; - -me | -ME ) - mesh=$value - ;; - -ml | -ML ) - memlimit=$value - ;; - -mo | -MO ) - ;; - -mpi | -MPI ) - mpioption=true - MARC_MPITYPE=$value - if test "$value" != "$MPI_DEFAULT"; then - exefile=marc_$value - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a_$value - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a_$value" - fi - else - exefile=marc - . $MARC_INCLUDE - MDSRCLIB=$MARC_LIB/mdsrc.a - if test "$MUMPSSOLVER" = MUMPS; then - MUMPSSOLVERLIBS="$MARC_LIB/libmumps.a" - fi - fi - ;; - -dir* | -DIR*) - DIRJOB=$value - case $DIRJOB in - \/*) - ;; - *) - DIRJOB=`pwd`/$DIRJOB - ;; - esac - if test -z "$DIRSCRSET" - then - DIRSCR=$DIRJOB - fi - ;; - -sd* | -SD*) - DIRSCR=$value - DIRSCRSET=yes - case $DIRSCR in - \/*) - ;; - *) - DIRSCR=`pwd`/$DIRSCR - ;; - esac - ;; - -ho* | -HO*) - host=$value - ;; - -co* | -CO*) - compatible=$value - ;; - -ci* | -CI*) - cpinput=$value - ;; - -cr* | -CR*) - cpresults=$value - ;; - *) - error="$error -$arg: invalid option" - break - ;; - esac - case $value in - -*) - error="$error -$arg: invalid name $value" - break - ;; - esac - shift - arg=$1 - if [ ${arg}X = -i8X -o ${arg}X = -I8X -o ${arg}X = -i4X -o ${arg}X = -I4X ] ; then - shift - arg=$1 - fi -done -argc=`expr $# % 2` -if test $argc -eq 1 -then -# -# odd number of arguments -# - error="$error -argument list incomplete" -fi - -if test $nprocdddm -gt 0 -then -nprocd=$nprocdddm -fi - -if test $nsolver -gt 0 -then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi -fi -# Set defaults -if test $nt -eq -1 -then -nt=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nt -lt 0 -then -nt=0 -fi -if test $nte -eq -1 -then -nte=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nte -lt 0 -then -nte=0 -fi -if test $nts -eq -1 -then -nts=${MARC_NUMBER_OF_THREADS:-0} -fi -if test $nts -lt 0 -then -nts=0 -fi -# -# set number of element loop threads -# -ntprint=$nt -nteprint=$nte -# copy from -nprocd[s] -if test $nprocdddm -gt 1 -then - nteprint=$nprocdddm -fi -# override with -nthread_elem option -if test $nte -ne 0 -then -nteprint=$nte -fi -# check for minimum 1 threads per processes for DDM -if test $nprocdddm -gt 1 -then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi -fi -nte=$nteprint -# -# set number of Solver threads -# -ntsprint=$nts -# copy from -nthread or -nprocd[s] -if test $ntprint -ne 0 -then - ntsprint=$ntprint -else - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -fi -# override with -nthread_solver option -if test $nts -ne 0 -then - ntsprint=$nts -fi -# check for minimum 1 threads per solver process. -if test $nsolver -lt $nprocdddm -then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi -else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi -fi -if test $ntsprint -eq 1 -then - set ntsprint=0 -fi -nts=$ntsprint - -# set stack size for multi-threading. -export KMP_MONITOR_STACKSIZE=7M -export OMP_STACKSIZE=7M - -# -# deprecate -nthread option at arugment of marc -nt=0 -# Reset nprocdddmm, nsolver and threads if not given. -if test $nprocdddm -eq 0 -then - nprocdarg= -fi -if test $nprocdddm -eq 0 -then - nprocdddmprint= -fi -if test $nprocdddm -eq 0 -then - nprocdddm= -fi - -nsolverprint=$nsolver -if test $nsolver -eq 0 -then - nsolverprint= -fi -# end of threads setting. -gpuoption= -if test "$gpuids" = "" ; then - gpuoption= -else - gpuoption="-gp $gpuids" -fi - -if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH -else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH -fi -# Linux 64 + HPMPI, Below code is taken from include_linux64 -if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" -then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" -fi - -if test $nprocd -gt 1; then - if test -f $jid$dotdefhost; then - if test "$host" = ""; then - host=$jid$dotdefhost - fi - fi - if test -f hostfile_qa_$nprocd; then - if test "$host" = ""; then - host=hostfile_qa_$nprocd - fi - fi -fi - -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$dllrun" -eq 1 || test "$dllrun" -eq 2; then - dotdat=.inp - fi - - if test "$progdll"; then - /bin/cp ${progdll}_$marcdll $DIRJOB/$marcdll - rmdll=yes - pathdll=yes - progdll=${progdll}_$marcdll - else - progdll=$marcdll - fi - - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - pathdll=yes - fi -fi - -############################################################################## -# check parameter validity # -############################################################################## - -while test forever; do - -# -# check for input file existence -# -if test $nprocdddm -gt 1 -a $icreated -eq 0; then - if test ! -f $DIRJID/1$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/1$jid$dotdat not accessible" - fi - fi -else - if test ! -f $DIRJID/$jid$dotdat; then - if test "$jid" != "" ; then - error="$error -input file $DIRJID/$jid$dotdat not accessible" - fi - fi -fi - if test $nprocd -gt 1; then - if test "$host" ; then - if test ! -f $host; then - error="$error -host name file $host not accessible" - fi - fi - fi - -# -# check if the job is already running in the background -# -if test -f $DIRJOB/$jid.pid; then - error="$error -job is already running (the file $jid.pid exists)" -fi - -# -# if the program name is other than marc, then -# assume that this is a program in the users local directory -# - -bd=$MARC_BIN/ - -case $prog in - marc | MARC | $exefile) - program=$exefile - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 or $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - if test ! -f $user - then - error="$error -user subroutine file $user not accessible" - fi - fi - if test "$objs" - then - missingobjs= - for o in $objs - do - if test ! -f "$o" - then - if test -z "$missingobjs" - then - missingobjs="$o" - else - missingobjs="$missingobjs $o" - fi - fi - done - if test -n "$missingobjs" - then - error="$error -user object/library file(s) $missingobjs not accessible" - fi - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$vid" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRVID/1$vid.vfs - then - error="$error -view factor file $DIRVID/1$vid.vfs not accessible" - fi - else - if test ! -f $DIRVID/$vid.vfs - then - error="$error -view factor file $DIRVID/$vid.vfs not accessible" - fi - fi - fi - if $mpioption - then - notok=true - for i in "$MPI_OTHER"; do - if test "$MARC_MPITYPE" = "$i"; then - notok=false - fi - done - if test "$MARC_MPITYPE" = "$MPI_DEFAULT"; then - notok=false - fi - if $notok; then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE (valid: $MPI_OTHER)" - fi - fi - ;; - *) - program=$prog.marc - case $prog in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - if test "$rid" - then - if test ! -f $DIRRID/$rid.t08 - then - error="$error -restart file $DIRRID/$rid.t08 not accessible" - fi - fi - if test "$pid" - then - if test ! -f $DIRPID/$pid.t16 - then - if test ! -f $DIRPID/$pid.t19 - then - error="$error -post file $DIRPID/$pid.t16 and $DIRPID/$pid.t19 not accessible" - fi - fi - fi - if test "$user" - then - error="$error -program option may not be used with user subroutine" - fi - if test "$objs" - then - error="$error -program option may not be used with user objects or libraries" - fi - if test "$did" - then - if test $nprocdddm -gt 1 -a $icreated -eq 0 - then - if test ! -f $DIRDID/1$did$dotdat - then - error="$error -defaults file $DIRDID/1$did$dotdat not accessible" - fi - else - if test ! -f $DIRDID/$did$dotdat - then - error="$error -defaults file $DIRDID/$did$dotdat not accessible" - fi - fi - fi - if test "$nauto" - then - if test $nauto -gt 2 - then - error="$error -incorrect option for auto restart " - fi - fi - if test "$ndcoup" - then - if test $ndcoup -gt 3 - then - error="$error -incorrect option for contact decoupling " - fi - fi - if test "$ndytran" - then - if test $ndytran -gt 1 - then - error="$error -incorrect option for Marc-Dytran Switch " - fi - fi - if $mpioption - then - if test ! -x $MARC_BIN/$exefile - then - error="$error -incorrect option for -mpi option: $MARC_MPITYPE " - fi - fi - ;; -esac - -############################################################################## -# check argument integrity # -############################################################################## - -if test "$jid" -then - : -else - if test "$user" - then -# allow user sub without giving job id - qid=foreground - verify=no - else - error="$error -job id required" -fi -fi - -if test $nprocd -gt 1 -then - if test $nauto -gt 0 - then - error="$error -cannot run DDM job with auto restart (-au) option " - fi -fi -case $qid in - S* | s*) - qid=short - ;; - L* | l*) - qid=long - ;; - V* | v*) - qid=verylong - ;; - B* | b*) - qid=background - ;; - F* | f*) - qid=foreground - ;; - A* | a*) - qid=at - ;; - *) - error="$error -bad value for queue_id option" - ;; -esac - -case $prgsav in - N* | n*) - prgsav=no - ;; - Y* | y*) - prgsav=yes - ;; - *) - error="$error -bad value for save option" - ;; -esac - -case $verify in - N* | n*) - verify=no - ;; - Y* | y*) - verify=yes - ;; - *) - error="$error -bad value for verify option" - ;; -esac - -case $nprocdddm in - -* ) - error="$error -bad value for nprocd option" - ;; -esac - -case $nt in - -* ) - error="$error -bad value for nt option" - ;; -esac - -case $itree in - -* ) - error="$error -bad value for itree option" - ;; -esac -case $iam in - -* ) - error="$error -bad value for iam option" - ;; -esac -case $compatible in - N* | n*) - compatible=no - ;; - Y* | y*) - compatible=yes - ;; - unknown) - ;; - *) - error="$error -bad value for comp option" - ;; -esac -case $cpinput in - N* | n*) - cpinput=no - ;; - Y* | y*) - cpinput=yes - ;; - *) - error="$error -bad value for copy input option" - ;; -esac -case $cpresults in - N* | n*) - cpresults=no - ;; - Y* | y*) - cpresults=yes - ;; - *) - error="$error -bad value for copy results option" - ;; -esac - -# -# check for external file to run -# -if test -f $MARC_TOOLS/run_marc_check -then - . $MARC_TOOLS/run_marc_check -fi - -############################################################################## -# interact with the user to get the required information to run marc or # -# other marc system program # -############################################################################## - -deletelog=yes -if test $qid = background -a $verify = no -then -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint -GPGPU option : $gpuids -Host file name : $host" > $jid.log -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" >> $jid.log -fi -echo \ -"Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto " >> $jid.log -deletelog=no -fi -echo \ -" -Program name : $prog -Marc shared lib : $progdll -Version type : $mode -Job ID : $DIRJID/$jid -User subroutine name : $user -User objects/libs : $objs -Restart file job ID : $rid -Substructure file ID : $sid -Post file job ID : $pid -Defaults file ID : $did -View Factor file ID : $vid -Save generated module: $prgsav -MPI library : $MPITYPE -DDM processes : $nprocdddmprint -Element loop threads : $nteprint -Solver processes : $nsolverprint -Solver threads : $ntsprint" -if test "$iprintsimufact" = true ; then - echo "DDM with ARC Mapper : $ddm_arc" -fi -echo \ -"GPGPU option : $gpuids -Host file name : $host -Message passing type : $itree -Run job in queue : $qid -Run directory : $DIRJOB -Scratch directory : $DIRSCR -Memory limit in Mbyte: $memlimit -Auto Restart : $nauto" - - -case $qid in - s* | S* | l* | L* | v* | V* ) - echo \ -"Queue priority : $priority -Queue CPU limit : $cpu -Queue start time : $att" - ;; -# * ) -# echo \ -#" " -# ;; -esac - -if test "$modeoption" -then - error=$modeerror -fi - -if test "$error" -then - if test $verify = yes - then - $ECHO "$error - -Please correct or quit(correct,quit,): $ECHOTXT" - error= - read answer - case $answer in - q* | Q*) - answer=quit - ;; - *) - answer=correct - ;; - esac - else - $ECHO "$error - $ECHOTXT" - echo " " - if test "$deletelog" = no - then - $ECHO "$error - $ECHOTXT" >> $jid.log - echo " " >> $jid.log - fi - answer=quit - fi -else - if test $verify = yes - then - $ECHO " -Are these parameters correct (yes,no,quit,)? $ECHOTXT" - read answer - case $answer in - q* | Q*) - answer=quit - ;; - y* | Y*) - answer=yes - ;; - *) - answer=no - ;; - esac - else - answer=yes - fi -fi - -case $answer in - no | correct) - -############################################################################## -# prompt for each value # -############################################################################## - - $ECHO " -Program name ($prog)? $ECHOTXT" - read value - if test "$value" - then - prog=$value - fi - $ECHO "Job ID ($jid)? $ECHOTXT" - read value - if test "$value" - then - jid=`$BASENAME $value $dotdat` - DIRJID=`dirname $value` - case $DIRJID in - \/*) - ;; - *) - DIRJID=`pwd`/$DIRJID - ;; - esac - fi - $ECHO "User subroutine name ($user)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - user= - ;; - *) - user=$value - case $user in - \/*) - ;; - *) - user=`pwd`/$user - ;; - esac - usernoext=$user - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .F` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .for` - usernoext=`dirname $usernoext`/`$BASENAME $usernoext .f90` - ;; - esac - fi - $ECHO "User objects or libraries ($objs)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - objs= - ;; - *) - objs="$value" - ;; - esac - fi - $ECHO "Restart File Job ID ($rid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - rid= - ;; - *) - rid=`$BASENAME $value .t08` - DIRRID=`dirname $value` - case $DIRRID in - \/*) - ;; - *) - DIRRID=`pwd`/$DIRRID - ;; - esac - ;; - esac - fi - $ECHO "Substructure File ID ($sid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - sid= - ;; - *) - sid=$value - DIRSID=`dirname $value` - case $DIRSID in - \/*) - ;; - *) - DIRSID=`pwd`/$DIRSID - ;; - esac - ;; - esac - fi - $ECHO "Post File Job ID ($pid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - pid= - ;; - *) - pid=$value - DIRPID=`dirname $value` - case $DIRPID in - \/*) - ;; - *) - DIRPID=`pwd`/$DIRPID - ;; - esac - ;; - esac - fi - $ECHO "Defaults File ID ($did)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - did= - ;; - *) - did=`$BASENAME $value $dotdat` - DIRDID=`dirname $value` - case $DIRDID in - \/*) - ;; - *) - DIRDID=`pwd`/$DIRDID - ;; - esac - ;; - esac - fi - $ECHO "View Factor File ID ($vid)? $ECHOTXT" - read value - if test "$value" - then - case $value in - -*) - vid= - ;; - *) - vid=`$BASENAME $value .vfs` - DIRVID=`dirname $value` - case $DIRVID in - \/*) - ;; - *) - DIRVID=`pwd`/$DIRVID - ;; - esac - ;; - esac - fi - $ECHO "Save generated module ($prgsav)? $ECHOTXT" - read value - if test "$value" - then - prgsav=$value - fi - $ECHO "Run on tasks ($nprocdddm) tasks? $ECHOTXT" - read value - if test "$value" - then - nprocdddm=$value - nprocdddmprint=$value - fi - $ECHO "Run on ($nte) Element loop threads ? $ECHOTXT" - read value - if test "$value" - then - nte=$value - fi - $ECHO "Run on ($nsolver) solvers ? $ECHOTXT" - read value - if test "$value" - then - nsolver=$value - fi - $ECHO "Run on ($nts) Solver threads ? $ECHOTXT" - read value - if test "$value" - then - nts=$value - fi -# - if test $nprocdddm -gt 0 - then - nprocd=$nprocdddm - fi - if test $nsolver -gt 0 - then - if test $nsolver -gt $nprocd - then - nprocd=$nsolver - fi - fi -# Element loop threads. - if test $nte -eq -1 - then - nte=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nte -lt 0 - then - nte=0 - fi - nteprint=$nte -# Copy from ddm - if test $nprocdddm -gt 1 - then - nteprint=$nprocdddm - fi -# override with -nthread_elem option - if test $nte -ne 0 - then - nteprint=$nte - fi -# check for minimum 1 threads per processes for DDM - if test $nprocdddm -ne 0 - then - if test $nteprint -lt $nprocdddm - then - nteprint=$nprocdddm - fi - fi - nte=$nteprint -# Solver threads. - if test $nts -eq -1 - then - nts=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nts -lt 0 - then - nts=0 - fi - ntsprint=$nts -# Copy from ddm - if test $nprocdddm -gt 1 - then - ntsprint=$nprocdddm - fi -# override with -nthread_solver option - if test $nts -ne 0 - then - ntsprint=$nts - fi -# check for minimum 1 threads per solver process. - if test $nsolver -lt $nprocdddm - then - if test $ntsprint -lt $nsolver - then - ntsprint=$nsolver - fi - else - if test $ntsprint -lt $nprocdddm - then - ntsprint=$nprocdddm - fi - fi - if test $ntsprint -eq 1 - then - set ntsprint=0 - fi - nts=$ntsprint -# Update print variable for -nsolver option - nsolverprint=$nsolver - if test $nsolver -eq 0 - then - nsolverprint= - fi - $ECHO "GPGPU id option ($gpuids)? $ECHOTXT" - read value - if test "$value" - then - gpuids=$value - fi - if test "$gpuids" = "" ; then - gpuoption= - else - gpuoption="-gp $gpuids" - fi - if test "$gpuids" = "" ; then - export LD_LIBRARY_PATH=$CUDALIB1:$LD_LIBRARY_PATH - else - MARCCUDALIBS=$MARCCUDALIBS2 - export LD_LIBRARY_PATH=$CUDALIB2:$LD_LIBRARY_PATH - fi - if test $MPITYPE = hpmpi -a "$ARCHITECTURE" = "linux_amd64" - then - export MPIHPSPECIAL="$MPIHPSPECIAL -e LD_LIBRARY_PATH=$LD_LIBRARY_PATH" - fi -# - if test $nprocd -gt 1 - then - $ECHO "Message passing type ($itree)? $ECHOTXT" - read value - if test "$value" - then - itree=$value - fi - $ECHO "Host file name ($host)? $ECHOTXT" - read value - if test "$value" - then - host=$value - fi - if test $nprocdddm -gt 1 - then - $ECHO "Single input file? $ECHOTXT" - read value - case $value in - y* | Y*) - icreated=1 - nprocdarg=-nprocds - ;; - esac - $ECHO "Compatible machines for DDM ($compatible)? $ECHOTXT" - read value - if test "$value" - then - compatible=$value - fi - $ECHO "Copy input files to remote hosts ($cpinput)? $ECHOTXT" - read value - if test "$value" - then - cpinput=$value - fi - $ECHO "Copy post files from remote hosts ($cpresults)? $ECHOTXT" - read value - if test "$value" - then - cpresults=$value - fi - fi - fi - $ECHO "Run the job in the queue ($qid)? $ECHOTXT" - read value - if test "$value" - then - qid=$value - fi - case $qid in - s* | S* | l* | L* | v* | V* ) - $ECHO "Queue priority ($priority)? $ECHOTXT" - read value - if test "$value" - then - priority=$value - fi - $ECHO "Job starts at ($att)? $ECHOTXT" - read value - if test "$value" - then - att=$value - fi - $ECHO "Queue CPU limit ($cpu)? $ECHOTXT" - read value - if test "$value" - then - cpu=$value - fi - ;; - * ) - ;; - esac - $ECHO "Auto Restart option ($nauto)? $ECHOTXT" - read value - if test "$value" - then - nauto=$value - fi - $ECHO "Run directory ($DIRJOB)? $ECHOTXT" - read value - if test "$value" - then - DIRJOB=$value - DIRSCR=$DIRJOB - fi - $ECHO "Scratch directory ($DIRSCR)? $ECHOTXT" - read value - if test "$value" - then - DIRSCR=$value - fi - ;; - quit) - exit 1 - ;; - *) - break - ;; - -esac - - if test $nt -eq -1 - then - nt=${MARC_NUMBER_OF_THREADS:-0} - fi - if test $nt -lt 0 - then - nt=0 - fi - -done -# -if test $nt -eq 0 -then - ntarg= -fi -if test $nt -eq 0 -then - ntprint= -fi -if test $nt -eq 0 -then - nt= -fi - -if test $nte -eq 0 -then - ntearg= -fi -if test $nte -eq 0 -then - nteprint= -fi -if test $nte -eq 0 -then - nte= -fi - -if test $nts -eq 0 -then - ntsarg= -fi -if test $nts -eq 0 -then - ntsprint= -fi -if test $nts -eq 0 -then - nts= -fi -# -if test "$dllrun" -gt 0; then - exefile=exe_marc - prog=exe_marc - program=$exefile - bd=$MARC_BIN/ - if test "$user"; then - . $MARC_TOOLS/make_marc_user_dll $DIRJOB $user - user= - pathdll=yes - if test $prgsav = no; then - rmdll=yes - fi - if test $prgsav = yes; then - cpdll=yes - rmdll=yes - fi - fi - - if test "$pathdll"; then -# -# reset share lib path -# - if test $MACHINENAME = "HP" - then - SHLIB_PATH=$DIRJOB:$SHLIB_PATH - export SHLIB_PATH - fi - if test $MACHINENAME = "IBM" - then - LIBPATH=$DIRJOB:$LIBPATH - export LIBPATH - fi -# - LD_LIBRARY_PATH=$DIRJOB:$LD_LIBRARY_PATH - LD_LIBRARY64_PATH=$DIRJOB:$LD_LIBRARY64_PATH - LD_LIBRARYN32_PATH=$DIRJOB:$LD_LIBRARYN32_PATH - export LD_LIBRARY_PATH - export LD_LIBRARY64_PATH - export LD_LIBRARYN32_PATH - fi -fi -# end of dllrun>0 - - -if test $program = $exefile -o $program = $prog.marc -then - -# delete the old .log file unless we run in the background -if test "$deletelog" = yes -then - if test "$jid" - then - /bin/rm $jid.log 2>/dev/null - fi -else - echo - echo running the job in the background, see $jid.log - echo -fi - -# -# check if this is an autoforge or rezoning or radiation job -# -if test $nprocd -eq 1 -a "$jid" - -then - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^autoforge"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^rezoning"` - if test "$line" - then - autoforge=1 - fi - line=`$AWK '/^[eE][nN][dD]/ {exit} ; {print}' $DIRJID/${jid}$dotdat | grep -i "^radiation"` - if test "$line" - then - autoforge=1 - fi -fi -# -# check that jobname for restarted run is not the same -# as restart file basename -# -if test "$rid" -then - if test "$jid" = "$rid" - then - echo " " - echo "ERROR: job name of current run is the same as job name" - echo " of the restarted job" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "ERROR: job name of current run is the same as job name" >> $jid.log - echo " of the restarted job" >> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi -fi - -# -# user objects/libraries used -# - - if test "$objs" - then - program="$DIRJOB/$jid.marc" - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# user subroutine used -# -# add DAMASK options for linking - DAMASK="-lstdc++" - - if test "$user" - then - program=$usernoext.marc - case $program in - \/* | \.\/*) - bd= - ;; - *) - bd=`pwd`/ - ;; - esac - link=yes - fi - -# -# Special case for IBM using POE but not an SP machine -# in this case we always need a host file, also for serial jobs. -# -if test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP -then - MP_HOSTFILE=${jid}.host - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $nprocd -gt 1 - then - numdom=$nprocd - while test $numdom -gt 0 - do - hostname -s >> $MP_HOSTFILE - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - else - hostname -s > $MP_HOSTFILE - fi -fi -# -# check ssh for all hosts in host file -# -if test $nprocd -gt 1 -then -if test $MPITYPE = "intelmpi" -a "$INTELMPI_VERSION" = "HYDRA" - then -# get host list - if test "$host" - then - line=`grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' | uniq` -# count failing hosts - counter=0 - for i in $line - do - $RSH -o BatchMode=yes -o ConnectTimeout=10 $i uname -n - status=$? - if [[ $status != 0 ]] ; then - counter=$((counter+1)) - if [ "$counter" = "1" ]; then - echo " " - echo " error - connection test failed... " - echo " " - fi - echo " " - echo " connection test with ssh failed on host $i" - echo " check the following command: ssh $i uname -n " - echo " " - fi - done -# echo error message and quit - if test $counter -ne 0 - then - echo " " - echo " A parallel job using IntelMPI cannot be started. " - echo " The ssh command must be working correctly between " - echo " the computers used in the analysis. Furthermore, " - echo " it must be set up such that it does not prompt the " - echo " user for a password. " - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo " A parallel job using IntelMPI cannot be started. ">> $jid.log - echo " The ssh command must be working correctly between ">> $jid.log - echo " the computers used in the analysis. Furthermore, ">> $jid.log - echo " it must be set up such that it does not prompt the ">> $jid.log - echo " user for a password. ">> $jid.log - echo " " >> $jid.log - echo " Exit number 8" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi -fi -fi -# -# check correctness of host file; fix for user sub -# - if test $nprocd -gt 1 - then - -# construct the path name to the executable (execpath) - execpath=$MARC_BIN/$exefile - usersub=0 - if test $program = $prog.marc - then - execpath=$prog.marc - usersub=1 - fi - if test "$objs" - then - execpath="$DIRJOB/$jid.marc" - usersub=1 - fi - if test "$user" - then - execpath=$usernoext.marc - usersub=1 - fi - export execpath - execname=`$BASENAME $execpath` - - if test "$host" - then - userhost=$host - case $userhost in - \/* | \.\/*) - ;; - *) - userhost=`pwd`/$userhost - ;; - esac - -# check that the number of processes specified in the hostfile is -# equal to nprocd specified by -nprocd. - numproc=`grep -v '^#' $host | $AWK -v sum=0 '{sum=sum+$2}; END {print sum}'` - if test $nprocd -ne $numproc - then - echo " " - echo "error, the number of processes specified in the host file" - echo "must be equal to the number of processes given by -nprocd/-nsolver" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, the number of processes specified in the host file" >> $jid.log - echo "must be equal to the number of processes given by -nprocd/-nsolver" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - -# check for Myrinet that the number of processes per host is -# less than number of available user ports, 5 -# .gmpi directory must exist in user's home directory -# and must have write permission from remote hosts - if test $MPITYPE = "myrinet" - then - numproc=`grep -v '^#' $host | $AWK -v sum=1 '{if( $2 > 5) sum=6}; END {print sum}'` - if test $numproc -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes specified " - echo "in the hostfile must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes specified " >> $jid.log - echo "in the hostfile must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - if test ! -d ~/.gmpi - then - echo " " - echo "error, for Myrinet a .gmpi directory must exist " - echo "under the user's home directory" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a .gmpi directory must exist " >> $jid.log - echo "under the user's home directory" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - homedir=`echo ~` - for i in `grep -v '^#' $host | $AWK '{if (NF > 0) print $1}'` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - $RSH $i /bin/touch $homedir/.gmpi/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - echo " " - echo "error, for Myrinet a shared .gmpi directory must exist " - echo "under the user's home directory " - echo "with remote write permission" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet a shared .gmpi directory must exist " >> $jid.log - echo "under the user's home directory " >> $jid.log - echo "with remote write permission" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - else - /bin/rm tmp.$$ - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - fi - fi - done - fi - fi - -# construct the host file $jid.host which is used by mpirun -# skip lines starting with # and only consider lines with more than -# one word in them. Note that the hostfile given to this script -# has two columns: the host name and the number of shared processes -# to run on this host. mpirun wants the number of _other_ -# processes to run in addition to the one being run on the machine -# on which the job is started. hence the $2-1 for fnr == 1. - if test -f $jid.host - then - /bin/rm $jid.host 2> /dev/null - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then -# HPMPI or HP hardware MPI - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ - -v mpihpspecial="$MPIHPSPECIAL" \ -'{if ( NF > 0) {\ - fnr++ ; \ - printf("-h %s -np %s",$1,$2); \ - printf(" %s",mpihpspecial); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF >= 3 ) printf(" -e MPI_WORKDIR=%s", $3);\ - if ( NF >= 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) \ - }\ - }' > $jid.host -# end HPMPI or HP hardware MPI - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then -# IBM using hardware MPI (POE) - MP_HOSTFILE=$jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.host -# end IBM using hardware MPI (POE) -# for Intel MPI, need to create a machinefile for DMP - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then -# Intel MPI - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - /bin/cp $host $jid.host - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Intel MPI for DMP -# for Solaris HPC 7.1, need to create a machinefile for DMP - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then -# Solaris HPC 7.1 - if test -f $jid.mfile - then - /bin/rm $jid.mfile 2> /dev/null - fi - grep -v '^#' $host | $AWK '{host=$1;num=$2;for (i=1;i<=num;i++) print host}' > $jid.mfile -# end Solaris HPC 7.1 for DMP -# for Myrinet, construct a configuration file in ~/.gmpi -# this must be readable by each process -# format is (hostname) (port number) for each process - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - grep -v '^#' $host | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ -{if ( NF > 0 ) \ - for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc]); \ -}' >> ~/.gmpi/$jid.host - else -# this is for mpich-1.2.5 and later, using the -pg option -# format: host nproc executable user arguments -# the arguments are added later - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub -v user=`whoami` \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s %s\n",path,user);\ - if ( NF == 3 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s %s\n",path,user) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s %s\n",$3,en,user); else printf(" %s/bin/%s %s\n",$4,en,user) \ - }\ - }' > $jid.host - fi -# end Myrinet - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then -# Compaq MPI via Memory Channel - grep -v '^#' $host | $AWK '{if (NF > 0) print $1}' > $jid.host -# end Compaq MPI - else -# MPICH - grep -v '^#' $host | $AWK -v path=$execpath -v en=$execname -v us=$usersub \ -'{if ( NF > 0) {\ - fnr++ ; \ - if ( fnr == 1 ) printf("%s %d",$1,$2-1); \ - else printf("%s %s",$1,$2); \ - if ( NF == 2 ) printf(" %s\n",path);\ - if ( NF == 3 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s\n",path) ;\ - if ( NF == 4 ) if (us) printf(" %s/%s\n",$3,en); else printf(" %s/bin/%s\n",$4,en) \ - }\ - }' > $jid.host - fi -# define the variable host and host_filt -# host_filt is used for loops over hosts -# for Myrinet we need to use a filtered variant of userhost -# for others we can use $host - if test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - host=~/.gmpi/$jid.host - host_filt=$jid.host_tMp - grep -v '^#' $userhost | $AWK '{if (NF > 0) print $1}' > $host_filt - else - host=$jid.host - host_filt=$host - fi - else - host=$jid.host - host_filt=$host - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - host_filt=$jid.mfile - fi - fi -# figure out if the machines in the hostfile are nfs mounted -# or distributed and set the variable "dirstatus" accordingly. -# only perform the check if user subroutine is used -# or a user subroutine executable is used - - numfield=1 - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - numfield=2 - fi - DIR1=$DIRJOB - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - counter=0 - echo " " - echo "checking if local or shared directories for host" - if test "$deletelog" = no - then - echo "checking if local or shared directories for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - dirstatus[$counter]="shared" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - $RSH $i /bin/touch $DIR1/$jid.$$ 2> tmp.$$ - if test -s tmp.$$ - then - dirstatus[$counter]="local" - /bin/rm tmp.$$ - else - if test ! -f $jid.$$ - then - dirstatus[$counter]="local" - $RSH $i /bin/rm $DIR1/$jid.$$ - else - /bin/rm $jid.$$ - fi - fi - if test -f tmp.$$ - then - /bin/rm tmp.$$ - fi - if test -f $jid.$$ - then - /bin/rm $jid.$$ - fi - echo " ${dirstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${dirstatus[$counter]}" >> $jid.log - fi - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - fi - -# figure out if this is a compatible set of machines -# unless explicitly specified with flag -comp -# only perform the check if user subroutine is used -# or a user subroutine executable is used -# Myrinet does not support heterogeneous - if test $program = $prog.marc -o -n "$user" -o -n "$objs" - then - if test $compatible = "unknown" - then - thisname=$ARCH - compatible=yes - counter=0 - echo "checking if machines are compatible for host" - if test "$deletelog" = no - then - echo "checking if machines are compatible for host" >> $jid.log - fi - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]="yes" - $ECHO " $i $ECHOTXT" - if test "$deletelog" = no - then - $ECHO " $i $ECHOTXT" >> $jid.log - fi - othername=`$RSH $i uname -a | cut -f 1 -d " "` - if test $thisname != $othername - then - compatible=no - compstatus[$counter]="no" - fi - fi - echo " ${compstatus[$counter]}" - if test "$deletelog" = no - then - echo " ${compstatus[$counter]}" >> $jid.log - fi - done - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - fi - else - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - compstatus[$counter]=$compatible - fi - done - if test $compatible = "no" - then - echo "all machines assumed incompatible" - if test "$deletelog" = no - then - echo "all machines assumed incompatible" >> $jid.log - fi - else - echo "all machines compatible" - if test "$deletelog" = no - then - echo "all machines compatible" >> $jid.log - fi - fi - fi -# error out if user objects or libraries are used on incompatible machines - if test "$compatible" = "no" -a -n "$objs" - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" - if test "$deletelog" = no - then - echo "User object/libraries cannot be used in a parallel job on incompatible machines" >> $jid.log - fi - exit 1 - fi -# modify new host file if NFS mounted heterogeneous machine - doit= - if test $program = $prog.marc - then - doit=yes - fi - if test "$user" - then - doit=yes - fi - if test "$doit" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - $AWK -v hst=$i '{fnr++ ; \ -if ($1 ~ hst) {if ( fnr == 1 ) printf("%s\n",$0); else \ -printf("%s %s %s_%s\n",$1,$2,$3,$1) } else print}' $jid.host > $jid.host{$$} - /bin/mv $jid.host{$$} $jid.host - host=$jid.host - fi - fi - done - fi - fi # if test $program = $prog.marc -o $user -o $obj - - else # if test $host - # assume shared memory machine if no hostfile given and - # MPITYPE is set to mpich or Myrinet - # check for Myrinet that the total number of processes is - # less than number of available user ports, 5 - if test $MPITYPE = "mpich" -o $MPITYPE = "scali" - then - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - host=$jid.host - elif test $MPITYPE = "myrinet" - then - if test $nprocd -gt 5 - then - echo " " - echo "error, for Myrinet the number of processes " - echo "must not exceed 5 for a hostname" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error, for Myrinet the number of processes " >> $jid.log - echo "must not exceed 5 for a hostname" >> $jid.log - echo " " >> $jid.log - fi - exit 1 - fi - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - echo $nprocd > ~/.gmpi/$jid.host - echo `hostname` $nprocd | $AWK \ -'BEGIN {iport[0] = 2; \ - iport[1] = 4; \ - iport[2] = 5; \ - iport[3] = 6; \ - iport[4] = 7 \ - } \ - {for(iproc = 0; iproc < $2; iproc++) printf("%s %d\n",$1,iport[iproc])} \ -' >> ~/.gmpi/$jid.host - host=~/.gmpi/$jid.host - else - numproc=`echo $nprocd | $AWK '{sum=$1-1}; {print sum}'` - echo `hostname` $numproc $execpath > $jid.host - - fi - fi # if test myrinet - - fi # if test $host - - fi # if test $nprocd -gt 1 - -fi # if test $program = $exefile -o $program = $prog.marc - -############################################################################## -# construct run stream (Marc only) # -############################################################################## - -# set maximum message length for ddm to a large number -# for vendor provided mpi -if test $itree -eq 0 -a $MPITYPE = hardware -then - itree=100000000 - if test $MACHINENAME = SGI - then - itree=100000001 - fi -fi -if test $itree -eq 0 -a $MPITYPE = hpmpi -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = myrinet -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = nec -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = scali -then - itree=100000000 -fi -if test $itree -eq 0 -a $MPITYPE = intelmpi -then - itree=100000000 -fi -if test $nprocdddm -lt 2 -then - nprocdarg= -else - nprocdarg="$nprocdarg $nprocdddm" -fi -if test $nsolver -eq 0 -then - nsolverarg= -else - nsolverarg="$nsolverarg $nsolver" -fi -if test $nprocdddm -lt 2 -a $nsolver -eq 0 -then -nprocd=0 -fi -if test $nprocd -gt 0 -then - if test "$host" - then - if test -z "$RUN_JOB2" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - if test $MPITYPE = hpmpi -o $MACHINENAME = HP -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $host -- -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = IBM -a $MPITYPE = hardware -a "$MACHINETYPE" = NONSP - then - RUN_JOB="$RUN_JOB2 $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MPITYPE = "myrinet" - then - if test $MPIVERSION = "MPICH-GM1.2.1..7" - then - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB_TMP="$RUN_JOB2 $host $bd$program" - RUN_JOB=" -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - elif test $MACHINENAME = DEC -a $MPITYPE = hardware - then - RUN_JOB="$RUN_JOB2 $nprocd -hf $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - elif test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - numhost=`uniq $jid.mfile | wc -l` - if test "$INTELMPI_VERSION" = "HYDRA" - then - RUN_JOB_TMP="$RUN_JOB2 -configfile $jid.cfile" - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n $numhost -r $RSH -f $jid.mfile - RUN_JOB_TMP="$RUN_JOB2 $jid.cfile" - fi - -# intelmpi uses configfile. format: -# -host host1 -n n1 executable marcargs -# one such line per host -# collect the marcargs in RUN_JOB and construct the config file later -# collect the run stream in RUN_JOB_TMP - RUN_JOB="-jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - - - elif test $MACHINENAME = "SUN" -a $MPITYPE = "hardware" - then - RUN_JOB="$RUN_JOB2 $jid.mfile -n $nprocd $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB2 $host $bd$program -jid $jid -dirjid $DIRJID \ -$nprocdarg \ -$nsolverarg \ --maxnum $MAXNUM -itree $itree \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test "$userhost" - then - RUN_JOB="$RUN_JOB -mhost $userhost" - fi - if test $MPITYPE = "scali" - then -# set default working directory to /tmp to allow -# different directory names - SCAMPI_WORKING_DIRECTORY=/tmp - export SCAMPI_WORKING_DIRECTORY - fi - else - if test -z "$RUN_JOB1" - then - echo " " - echo "error: parallel job attempted on non-parallel version," - echo " or, if parallel version is installed, the include " - echo " file is probably corrupted" - echo " " - if test "$deletelog" = no - then - echo " " >> $jid.log - echo "error: parallel job attempted on non-parallel version," >> $jid.log - echo " or, if parallel version is installed, the include " >> $jid.log - echo " file is probably corrupted" >> $jid.log - echo " " >> $jid.log - fi - exit - fi - RUNNPROCD=$nprocd - if test $MACHINENAME = "IBM" -a $MPITYPE = "hardware" - then - RUNNPROCD= - MP_PROCS=$nprocd - export MP_PROCS - fi - if test $MPITYPE = "myrinet" - then - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - echo " " > /dev/null - else - export I_MPI_JOB_CONTEXT=$$ - mpdboot -n 1 -f $jid.hosts - fi - RUN_JOB="$RUN_JOB1 $RUNNPROCD $bd$program -jid $jid -dirjid $DIRJID \ - $nprocdarg \ - $nsolverarg \ - -maxnum $MAXNUM -itree $itree \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi - fi -else - if test $nauto -gt 0 -o $ndcoup -gt 0 - then - RUN_JOB="$RUN_JOB0 $BINDIR/exe_auto $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ - $ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - else -# this is for a serial job without auto restart: - RUN_JOB="$RUN_JOB0 $bd$program -jid $jid -dirjid $DIRJID \ --maxnum $MAXNUM \ -$ntearg $nte $ntsarg $nts $gpuoption -dirjob $DIRJOB " - fi -fi -if test "$rid" -then - RUN_JOB="$RUN_JOB -rid $rid -dirrid $DIRRID" -fi -if test "$pid" -then - RUN_JOB="$RUN_JOB -pid $pid -dirpid $DIRPID" -fi -if test "$sid" -then - RUN_JOB="$RUN_JOB -sid $sid -dirsid $DIRSID" -fi -if test "$did" -then - RUN_JOB="$RUN_JOB -def $did -dirdid $DIRDID" -fi -if test "$vid" -then - RUN_JOB="$RUN_JOB -vf $vid -dirvid $DIRVID" -fi -if test $nauto -gt 0 -then - RUN_JOB="$RUN_JOB -autorst $nauto " -fi -if test $ndcoup -gt 0 -then - RUN_JOB="$RUN_JOB -dcoup $ndcoup " -fi -if test $ndytran -gt 0 -then - RUN_JOB="$RUN_JOB -dytran $ndytran " -fi -if test $mesh -gt 0 -then - RUN_JOB="$RUN_JOB -me $mesh " -fi -if test $noutcore -gt 0 -then - RUN_JOB="$RUN_JOB -outcore $noutcore " -fi -if test "$dllrun" -gt 0 -then - RUN_JOB="$RUN_JOB -dll $dllrun " -fi -if test "$trkrun" -gt 0 -then - RUN_JOB="$RUN_JOB -trk $trkrun " -fi -if test "$iam" -then - RUN_JOB="$RUN_JOB -iam $iam " -fi -if test "$justlist" -then - RUN_JOB="$RUN_JOB -list 1 " -fi -if test "$feature" -then - RUN_JOB="$RUN_JOB -feature $feature " -fi -if test "$memlimit" -ne 0 -then - RUN_JOB="$RUN_JOB -ml $memlimit " -fi -if test "$cpinput" -then - RUN_JOB="$RUN_JOB -ci $cpinput " -fi -if test "$cpresults" -then - RUN_JOB="$RUN_JOB -cr $cpresults " -fi -if test "$DIRSCR" != "$DIRJOB" -then - RUN_JOB="$RUN_JOB -dirscr $DIRSCR" -else - DIRSCR=$DIRJOB -fi -if test "$makebdf" -then - RUN_JOB="$RUN_JOB -bdf $makebdf " -fi -if test $MPITYPE = "myrinet" -a "$host" -a "$MPIVERSION" != "MPICH-GM1.2.1..7" -then - # append $RUN_JOB to all lines of the host file - # and set RUN_JOB - $AWK -v args="$RUN_JOB" '{print $0,args}' $host > $host.$$ - /bin/mv $host.$$ $host - RUN_JOB=$RUN_JOB_TMP -fi -if test $MPITYPE = "intelmpi" -a "$host" -then - # construct config file, append $RUN_JOB to all lines of the config file - # and set RUN_JOB - if test "$INTELMPI_VERSION" = "HYDRA" - then - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf(" -host %s",$1); \ - printf(" -n %s",$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - else - grep -v '^#' $host | $AWK -v args="$RUN_JOB" -v path=$execpath -v en=$execname -v us=$usersub \ - '{if ( NF > 0) {\ - printf("-host %s -n %s",$1,$2); \ - if ( NF == 2 ) printf(" %s",path);\ - if ( NF >= 3 ) printf(" -wdir %s ",$3); \ - if ( NF >= 3 ) if (us) printf(" %s/%s",$3,en); else printf(" %s",path); \ - printf(" %s\n",args); \ - }\ - }' > $jid.cfile - fi - RUN_JOB=$RUN_JOB_TMP -fi -echo " " -echo "Final run stream value" -echo " RUNJOB="$RUN_JOB -if test "$deletelog" = no -then -echo " " >> $jid.log -echo "Final run stream value" >> $jid.log -echo " RUNJOB="$RUN_JOB >> $jid.log -fi - - -############################################################################## -# run marc using valgrind # -############################################################################## -#RUN_JOB="valgrind $RUN_JOB" -#RUN_JOB="valgrind --read-var-info=yes --gen-suppressions=yes $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=all -v $RUN_JOB" -#RUN_JOB="valgrind --gen-suppressions=yes --error-limit=no $RUN_JOB" -############################################################################## - - -############################################################################## -# run the requested program in a queue # -############################################################################## - -if test "$deletelog" = yes -then - echo - date -else - echo >> $jid.log - date >> $jid.log -fi -if [ $qid = short -o $qid = long -o $qid = verylong -o $qid = at ] -then - -/bin/rm -f $jid.runmarcscript - - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - userobj=$usermoext.o - fi - cat > $jid.runmarcscript << END4 - if test "$user" - then - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - $SOLVERLIBS \ - $MARCCUDALIBS \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } -END4 -else - prgsav=yes -fi -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc -# - -cat >> $jid.runmarcscript << END5 - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# first remove all .out files and incremental restart files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - /bin/rm $DIRJOB/$numdom${jid}_i_*.t08 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null - /bin/rm $DIRJOB/${jid}_i_*.t08 2>/dev/null -fi - -if test $nprocdddm -gt 1 -then - $RUN_JOB 2>>$jid.log -else - $RUN_JOB 2>>$jid.log -fi - -if test $dllrun -eq 0; then - if test $prgsav = no - then - /bin/rm -f $bd$program 2>/dev/null - fi -else - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes - then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test \$numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - numdom=\`echo \$numdom | $AWK '{sum=\$1-1}; {print sum}'\` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null -fi -END5 - - -# Submit to marc batch queue -# -if [ $qid = at ] -then -QUENAME=at -SUBMCMD= -else -# -# Submit to qsub queue -# -QUENAME=qsub -SUBMCMD="-q $qid -o /dev/null -e $jid.batch_err_log -x -r $jid" -if test "$priority" -then - SUBMCMD=$SUBMCMD" -p $priority" -fi -if test "$att" -then - SUBMCMD=$SUBMCMD" -a $att" -fi -if test "$cpu" -then - SUBMCMD=$SUBMCMD" -lt $cpu" -fi - -fi -echo $QUENAME $SUBMCMD -#cat $jid.runmarcscript -$QUENAME $SUBMCMD < $jid.runmarcscript - -/bin/rm -f $jid.runmarcscript - -############################################################################## -# run the requested program in the background # -############################################################################## - -else -if test $qid = background -then - -# -# first remove all old .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi -# -# compile user subroutine if present -# -( -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - echo " $PRODUCT Exit number 3" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - echo " $PRODUCT Exit number 3" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - echo " $PRODUCT Exit number 3" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null - -# -# run marc - -# - -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - -$RUN_JOB & - -marcpid=$! -echo $marcpid > $DIRJOB/$jid.pid -wait $marcpid - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - fi - fi - fi -fi - - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi -) 1>>$jid.log 2>&1 & - - -############################################################################## -# run the requested program in the foreground # -############################################################################## - -else - -# -# compile user subroutine if present -# -if test "$link" -then - if test -z "$FCOMPROOT"; then - echo "$0: No compiler available" - echo - echo " $PRODUCT Exit number 3" - exit 1 - fi - echo - echo "Using compiler from: $FCOMPROOT" - echo - if test "$user" - then - # compile and link on other hosts in $host if compstatus=no - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${compstatus[$counter]} = "no" - then - DIR1=$DIRJOB - DIR2=$DIR - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - marcdir=`echo $line | $AWK '{print $4}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - if test -n "$marcdir" - then - DIR2=$marcdir - fi - # first copy over the user sub if local directories - if test ${dirstatus[$counter]} = "local" - then - $RCP $user $i:$DIR1/ - fi - # do the compilation on the other machine - if test ${dirstatus[$counter]} = "shared" - then - hname=_$ibase - else - hname= - fi - remoteprog=$DIR1/${execname}$hname - remoteuser=$DIR1/`$BASENAME $user` - $RSH $i /bin/rm $remoteprog 2> /dev/null - echo - $RSH $i $DIR2/tools/comp_damask_l $DIR2 $DIR1 $remoteuser $remoteprog - # check if successful, the new executable should be there - line=`$RSH $i /bin/ls $remoteprog 2> /dev/null` - if test "$line" - then - echo compilation and linking successful on host $i - else - echo "$0: compile failed for $user on host $i" - exit 1 - fi - # remove the user subroutine on remote machine - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $remoteuser 2> /dev/null - fi - fi - fi - done - fi - fi - if test "$userhost" - then - echo - echo "Compiling and linking user subroutine $user on host `hostname`" - fi - userobj=$usernoext.o - if test $MACHINENAME = "CRAY" - then - $DFORTLOW $user || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - else - $DFORTLOW $user -o $userobj || \ - { - echo "$0: compile failed for $user" - exit 1 - } - /bin/rm $program 2>/dev/null - fi - fi # if test $user - - - $LOAD $bd${program} $MARC_LIB/main.o \ - $MARC_LIB/blkdta.o $MARC_LIB/comm?.o \ - ${userobj-} \ - $objs \ - $MARC_LIB/srclib.a \ - $MNFLIBS \ - $MDUSER \ - ${MUMPSSOLVERLIBS} \ - $MDSRCLIB \ - $MARC_LIB/mcvfit.a \ - $STUBS \ - ${SOLVERLIBS} \ - ${MARCCUDALIBS} \ - $TKLIBS \ - $MRCLIBS \ - $METISLIBS \ - $DAMASK \ - $OPENSSL_LIB \ - $SYSLIBS \ - $SFLIB \ - $SECLIBS || \ - { - echo "$0: link failed for ${user:+$userobj }$objs" - exit 1 - } - # copy user subroutine executable for hosts using local working dir - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - if test ${dirstatus[$counter]} = "local" -a ${compstatus[$counter]} = "yes" - then - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - echo "Copying executable to host ${i}" - $RCP $program ${i}:${DIR1}/ - fi - fi - done - fi - fi -else # if test $link - prgsav=yes -fi # if test $link -/bin/rm $userobj 2>/dev/null -/bin/rm $DIRJOB/*.mod 2>/dev/null -# done if no job id given -if test -z "$jid" -then - echo - echo only compilation requested - echo - exit -fi -# -# run marc -# -# Define share library path based on platforms -# This is required for using the Patran Mesher -if test $MACHINENAME = "IBM" -then - LIBPATH=$MARC_LIB:$MARC_LIB_SHARED:$LIBPATH - export LIBPATH -fi -# first remove all .out files -# the ones for ddm are removed in the code -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRJOB/$numdom$jid.out 2>/dev/null - /bin/rm $DIRJOB/$numdom$jid.log 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done -else - /bin/rm $DIRJOB/$jid.out 2>/dev/null -fi - -# for DDM with ARC support - -if test $ddm_arc -gt 0; then - RUN_JOB="$MESHERDIR/sf_exeddm $RUN_JOB -ddm $ddm_arc " -fi - - $RUN_JOB - -if test $nprocd -gt 1 -then - if test $MACHINENAME = "LINUX" -a $MPITYPE = "intelmpi" - then - if test "$INTELMPI_VERSION" = "HYDRA" - then - if test "$host" - then - /bin/rm $jid.mfile 2> /dev/null - /bin/rm $jid.hosts 2> /dev/null - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.cfile 2> /dev/null - else - echo " " > /dev/null - fi - else - if test "$host" - then - mpdcleanup -a -f $jid.mfile - /bin/rm $jid.host 2> /dev/null - /bin/rm $jid.mfile 2> /dev/null - else - mpdcleanup -a -f $jid.hosts - /bin/rm $jid.hosts 2> /dev/null - fi - fi - fi -fi - -if test $dllrun -eq 0; then -if test $prgsav = no -then - /bin/rm -f $bd$program 2>/dev/null - # for network run, remove executable on remote machines - # and executables with modified name - if test $nprocd -gt 1 - then - if test "$userhost" - then - counter=0 - if test -f "$host_filt" - then - for i in `$AWK -v n=$numfield '{print $n}' $host_filt` - do - ibase=${i%%.*} - if test $ibase != $thishost - then - counter=$((counter+1)) - DIR1=$DIRJOB - line=`grep -v '^#' $userhost | grep "^$ibase "` - workdir=`echo $line | $AWK '{print $3}'` - if test -n "$workdir" - then - DIR1=$workdir - fi - # if an incompatible host uses shared directory, - # then the root machine deletes the executable - if test ${dirstatus[$counter]} = "shared" -a ${compstatus[$counter]} = "no" - then - hname=_$ibase - /bin/rm ${execname}$hname - fi - # if local directory used, the remote machine - # deletes the executable - if test ${dirstatus[$counter]} = "local" - then - $RSH $i /bin/rm $DIR1/${execname} 2>/dev/null - fi - fi - done - fi - fi -fi -fi -else -#dllrun >0 - if test $cpdll = yes; then - filename=$usernoext - /bin/cp $DIRJOB/$marcdll $DIRJOB/${filename}_$marcdll 2>/dev/null - fi - if test $rmdll = yes;then - /bin/rm -f $DIRJOB/$marcdll 2>/dev/null - fi -fi - -if test $nprocdddm -gt 1 -then - numdom=$nprocdddm - while test $numdom -gt 0 - do - /bin/rm $DIRSCR/$numdom$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t74 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t75 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t76 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t77 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t78 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t79 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t84 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t85 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t86 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t87 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t88 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.t90 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sle 2>/dev/null - /bin/rm $DIRSCR/$numdom$jid.sin 2>/dev/null - numdom=`echo $numdom | $AWK '{sum=$1-1}; {print sum}'` - done - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - if test $MPITYPE = "myrinet" - then - if test -f "$host_filt" - then - /bin/rm $host_filt - fi - fi -else - /bin/rm $DIRSCR/$jid.t02 2>/dev/null - /bin/rm $DIRSCR/$jid.t03 2>/dev/null - /bin/rm $DIRSCR/$jid.t11 2>/dev/null - /bin/rm $DIRSCR/$jid.t12 2>/dev/null - /bin/rm $DIRSCR/$jid.t13 2>/dev/null - /bin/rm $DIRSCR/$jid.t14 2>/dev/null - /bin/rm $DIRSCR/$jid.t15 2>/dev/null - /bin/rm $DIRSCR/$jid.t22 2>/dev/null - /bin/rm $DIRSCR/$jid.t23 2>/dev/null - /bin/rm $DIRSCR/$jid.t32 2>/dev/null - /bin/rm $DIRSCR/$jid.t33 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t81* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t82* 2>/dev/null - /bin/rm $DIRSCR/$jid.*.t83* 2>/dev/null - /bin/rm $DIRSCR/$jid.t84 2>/dev/null - /bin/rm $DIRJOB/$jid.pid 2>/dev/null - /bin/rm $DIRJOB/$jid.sle 2>/dev/null - /bin/rm $DIRJOB/$jid.sin 2>/dev/null -fi - - -fi -fi diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/kill7 b/installation/mods_MarcMentat/2017/Mentat_bin/kill7 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/kill7 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/kill8 b/installation/mods_MarcMentat/2017/Mentat_bin/kill8 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/kill8 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/kill9 b/installation/mods_MarcMentat/2017/Mentat_bin/kill9 deleted file mode 100644 index 6d1ff84bf..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/kill9 +++ /dev/null @@ -1,8 +0,0 @@ -#!/bin/sh - -if [ "$1" = "" ]; then - echo "usage: $0 job_name" - exit 1 -fi - -echo STOP > $1.cnt diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/submit7 b/installation/mods_MarcMentat/2017/Mentat_bin/submit7 deleted file mode 100644 index d0e3be475..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/submit7 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_h" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/submit8 b/installation/mods_MarcMentat/2017/Mentat_bin/submit8 deleted file mode 100644 index d466fc6ab..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/submit8 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/2017/Mentat_bin/submit9 b/installation/mods_MarcMentat/2017/Mentat_bin/submit9 deleted file mode 100644 index 207a61803..000000000 --- a/installation/mods_MarcMentat/2017/Mentat_bin/submit9 +++ /dev/null @@ -1,187 +0,0 @@ -#!/bin/sh -# -# The exit status of this script is read by Mentat. -# Normal exit status is 0. -# - -DIR=%INSTALLDIR%/marc%VERSION% -if test $MARCDIR1 -then - DIR=$MARCDIR1 -fi - -if test -z "$DIR"; then - REALCOM="`ls -l $0 |awk '{ print $NF; }'`" - DIRSCRIPT=`dirname $REALCOM` - case $DIRSCRIPT in - \/*) - ;; - *) - DIRSCRIPT=`pwd`/$DIRSCRIPT - ;; - esac - . $DIRSCRIPT/getarch - - DIR="$MENTAT_MARCDIR" -fi - -SRCEXT=.f -SRCEXTC=.F -RSTEXT=.t08 -PSTEXT=.t19 -PSTEXTB=.t16 -VWFCEXT=.vfs - -slv=$1 -version=$2 -ndom_fea_solver=$3 -ndom_preprocessor=$4 -hostfile=$5 -compat=$6 -job=$7 -srcfile=$8 -srcmeth=$9 -shift 9 # cannot use $10, $11, ... -restart=$1 -postfile=$2 -viewfactorsfile=$3 -autorst=$4 -copy_datfile="-ci $5" -copy_postfile="-cr $6" -scr_dir=$7 -dcoup=$8 -assem_recov_nthread=$9 -shift 9 # cannot use $10, $11, ... -nthread=$1 -nsolver=$2 -mode=$3 -gpu=$4 - -if [ "$slv" != "" -a "$slv" != "marc" ]; then - slv="-iam sfm" -else - slv="" -fi - -if [ "$ndom_fea_solver" != "" -a "$ndom_fea_solver" != "1" ]; then - nprocds="-nprocds $ndom_fea_solver" -else - nprocd="" - if [ "$ndom_preprocessor" != "" -a "$ndom_preprocessor" != "1" ]; then - nprocd="-nprocd $ndom_preprocessor" - else - nprocd="" - fi -fi - -if [ "$srcfile" != "" -a "$srcfile" != "-" ]; then - srcfile=`echo $srcfile | sed "s/$SRCEXT$//" | sed "s/$SRCEXTC$//"` - case "$srcmeth" in - -) - srcfile="-u $srcfile" - ;; - compsave) - srcfile="-u $srcfile -save y" - ;; - runsaved) - srcfile=${srcfile%.*}".marc" - srcfile="-prog $srcfile" - ;; - esac -else - srcfile="" -fi - -if [ "$restart" != "" -a "$restart" != "-" ]; then - restart=`echo $restart | sed "s/$RSTEXT$//"` - restart="-r $restart" -else - restart="" -fi - -if [ "$postfile" != "" -a "$postfile" != "-" ]; then - postfile=`echo $postfile | sed "s/$PSTEXT$//"` - postfile=`echo $postfile | sed "s/$PSTEXTB$//"` - postfile="-pid $postfile" -else - postfile="" -fi - -if [ "$viewfactorsfile" != "" -a "$viewfactorsfile" != "-" ]; then - viewfactorsfile=`echo $viewfactorsfile | sed "s/$VWFCEXT$//"` - viewfactorsfile="-vf $viewfactorsfile" -else - viewfactorsfile="" -fi - -if [ "$hostfile" != "" -a "$hostfile" != "-" ]; then - hostfile="-ho $hostfile" -else - hostfile="" -fi - -if [ "$compat" != "" -a "$compat" != "-" ]; then - compat="-co $compat" -else - compat="" -fi - -if [ "$scr_dir" != "" -a "$scr_dir" != "-" ]; then - scr_dir="-sd $scr_dir" -else - scr_dir="" -fi - -if [ "$dcoup" != "" -a "$dcoup" != "0" ]; then - dcoup="-dcoup $dcoup" -else - dcoup="" -fi - -if [ "$assem_recov_nthread" != "" -a "$assem_recov_nthread" != "1" ]; then - assem_recov_nthread="-nthread_elem $assem_recov_nthread" -else - assem_recov_nthread="" -fi - -if [ "$nthread" != "" -a "$nthread" != "0" -a "$nthread" != "1" ]; then - nthread="-nthread $nthread" -else - nthread="" -fi - -if [ "$nsolver" != "" -a "$nsolver" != "0" ]; then - nsolver="-nsolver $nsolver" -else - nsolver="" -fi - -case "$mode" in - 4) mode="-mo i4" ;; - 8) mode="-mo i8" ;; - *) mode= ;; -esac - -if [ "$gpu" != "" -a "$gpu" != "-" ]; then - gpu="-gpu $gpu" -else - gpu="" -fi - -rm -f $job.cnt -rm -f $job.sts -rm -f $job.out -rm -f $job.log - -# To prevent a mismatch with the python version used by the solver -# do *not* prepend $MENTAT_INSTALL_DIR/python/bin to environment variable PATH -# unset environment variables PYTHONHOME and PYTHONPATH -unset PYTHONHOME -unset PYTHONPATH - -"${DIR}/tools/run_damask_l" $slv -j $job -v n -b y $nprocds $nprocd -autorst $autorst \ - $srcfile $restart $postfile $viewfactorsfile $hostfile \ - $compat $copy_datfile $copy_postfile $scr_dir $dcoup \ - $assem_recov_nthread $nthread $nsolver $mode $gpu > /dev/null 2>&1 -sleep 1 -exit 0 diff --git a/installation/mods_MarcMentat/apply_DAMASK_modifications.sh b/installation/mods_MarcMentat/apply_DAMASK_modifications.sh index 74abaf29c..d6cd6b171 100755 --- a/installation/mods_MarcMentat/apply_DAMASK_modifications.sh +++ b/installation/mods_MarcMentat/apply_DAMASK_modifications.sh @@ -58,15 +58,9 @@ echo "Editor: $EDITOR" echo '' echo 'adapting Marc tools...' theDIR=$INSTALLDIR/marc$VERSION/tools -for filename in 'comp_damask' \ - 'comp_damask_l' \ - 'comp_damask_h' \ - 'comp_damask_mp' \ +for filename in 'comp_damask_mp' \ 'comp_damask_lmp' \ 'comp_damask_hmp' \ - 'run_damask' \ - 'run_damask_l' \ - 'run_damask_h' \ 'run_damask_mp' \ 'run_damask_lmp' \ 'run_damask_hmp' \ @@ -85,15 +79,9 @@ for filename in 'edit_window' \ 'submit4' \ 'submit5' \ 'submit6' \ - 'submit7' \ - 'submit8' \ - 'submit9' \ 'kill4' \ 'kill5' \ - 'kill6' \ - 'kill7' \ - 'kill8' \ - 'kill9'; do + 'kill6'; do cp $SCRIPTLOCATION/$VERSION/Mentat_bin/$filename $theDIR echo $theDIR/$filename | xargs perl -pi -e "s:%INSTALLDIR%:${INSTALLDIR}:g" echo $theDIR/$filename | xargs perl -pi -e "s:%VERSION%:${VERSION}:g" @@ -122,8 +110,8 @@ echo '' echo 'setting file access rights...' for filename in marc$VERSION/tools/run_damask* \ marc$VERSION/tools/comp_damask* \ - mentat$VERSION/bin/submit{4..9} \ - mentat$VERSION/bin/kill{4..9} ; do + mentat$VERSION/bin/submit{4..6} \ + mentat$VERSION/bin/kill{4..6} ; do chmod 755 $INSTALLDIR/${filename} done @@ -142,10 +130,7 @@ if [ -d "$BIN_DIR" ]; then echo 'creating symlinks ...' echo'' theDIR=$INSTALLDIR/marc$VERSION/tools - for filename in 'run_damask' \ - 'run_damask_l' \ - 'run_damask_h' \ - 'run_damask_mp' \ + for filename in 'run_damask_mp' \ 'run_damask_lmp' \ 'run_damask_hmp'; do echo ${filename:4}$VERSION diff --git a/installation/mods_MarcMentat/installation.txt b/installation/mods_MarcMentat/installation.txt index ae1bca772..c2b56b3e6 100644 --- a/installation/mods_MarcMentat/installation.txt +++ b/installation/mods_MarcMentat/installation.txt @@ -21,16 +21,10 @@ The structure of this directory should be (VERSION = 20XX or 20XX.Y) ./installation.txt this text ./apply_MPIE_modifications script file to apply modifications to the installation ./VERSION/Marc_tools/comp_user.original original file from installation -./VERSION/Marc_tools/comp_damask modified version using -O1 optimization -./VERSION/Marc_tools/comp_damask_l modified version using -O0 optimization -./VERSION/Marc_tools/comp_damask_h modified version using -O2 optimization ./VERSION/Marc_tools/comp_damask_mp modified version using -O1 optimization and OpenMP ./VERSION/Marc_tools/comp_damask_lmp modified version using -O0 optimization and OpenMP ./VERSION/Marc_tools/comp_damask_hmp modified version using -O2 optimization and OpenMP ./VERSION/Marc_tools/run_marc.original original file from installation -./VERSION/Marc_tools/run_damask modified version using -O1 optimization -./VERSION/Marc_tools/run_damask_l modified version using -O0 optimization -./VERSION/Marc_tools/run_damask_h modified version using -O2 optimization ./VERSION/Marc_tools/run_damask_mp modified version using -O1 optimization and OpenMP ./VERSION/Marc_tools/run_damask_lmp modified version using -O0 optimization and OpenMP ./VERSION/Marc_tools/run_damask_hmp modified version using -O2 optimization and OpenMP @@ -42,14 +36,8 @@ The structure of this directory should be (VERSION = 20XX or 20XX.Y) ./VERSION/Mentat_bin/submit4 modified version of original calling run_h_marc ./VERSION/Mentat_bin/submit5 modified version of original calling run_marc ./VERSION/Mentat_bin/submit6 modified version of original calling run_l_marc -./VERSION/Mentat_bin/submit7 modified version of original calling run_hmp_marc -./VERSION/Mentat_bin/submit8 modified version of original calling run_mp_marc -./VERSION/Mentat_bin/submit9 modified version of original calling run_lmp_marc ./VERSION/Mentat_bin/kill4 kill file for submit4, identical to original kill1 ./VERSION/Mentat_bin/kill5 kill file for submit5, identical to original kill1 ./VERSION/Mentat_bin/kill6 kill file for submit6, identical to original kill1 -./VERSION/Mentat_bin/kill7 kill file for submit7, identical to original kill1 -./VERSION/Mentat_bin/kill8 kill file for submit8, identical to original kill1 -./VERSION/Mentat_bin/kill9 kill file for submit9, identical to original kill1 ./VERSION/Mentat_menus/job_run.ms.original original file from installation ./VERSION/Mentat_menus/job_run.ms modified version adding DAMASK menu to run menu diff --git a/installation/patch/python2to3.sh b/installation/patch/python2to3.sh new file mode 100755 index 000000000..1d86b0ce7 --- /dev/null +++ b/installation/patch/python2to3.sh @@ -0,0 +1,8 @@ +#! /usr/bin/env bash +if [ $1x != 3to2x ]; then + echo 'python2.7 to python' + find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python2.7/usr\/bin\/env python/g' +else + echo 'python to python2.7' + find . -name '*.py' | xargs sed -i 's/usr\/bin\/env python/usr\/bin\/env python2.7/g' +fi diff --git a/lib/damask/__init__.py b/lib/damask/__init__.py index 379b23547..9809ce5b2 100644 --- a/lib/damask/__init__.py +++ b/lib/damask/__init__.py @@ -6,6 +6,8 @@ import os with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f: version = f.readline()[:-1] +name = 'damask' + from .environment import Environment # noqa from .asciitable import ASCIItable # noqa diff --git a/lib/damask/config/material.py b/lib/damask/config/material.py index bb184b4d2..02658019d 100644 --- a/lib/damask/config/material.py +++ b/lib/damask/config/material.py @@ -277,5 +277,16 @@ class Material(): self.data[part.lower()][section.lower()][key.lower()] = value if newlen is not oldlen: print('Length of value was changed from %i to %i!'%(oldlen,newlen)) - + + def add_value(self, part=None, + section=None, + key=None, + value=None): + if not isinstance(value,list): + if not isinstance(value,str): + value = '%s'%value + value = [value] + print('adding %s:%s:%s with value %s '%(part.lower(),section.lower(),key.lower(),value)) + self.data[part.lower()][section.lower()][key.lower()] = value + self.data[part.lower()][section.lower()]['__order__'] += [key.lower()] diff --git a/lib/damask/util.py b/lib/damask/util.py index 413f955e9..8727a1473 100644 --- a/lib/damask/util.py +++ b/lib/damask/util.py @@ -36,8 +36,8 @@ class bcolors: def srepr(arg,glue = '\n'): """Joins arguments as individual lines""" if (not hasattr(arg, "strip") and - hasattr(arg, "__getitem__") or - hasattr(arg, "__iter__")): + (hasattr(arg, "__getitem__") or + hasattr(arg, "__iter__"))): return glue.join(str(x) for x in arg) return arg if isinstance(arg,str) else repr(arg) @@ -59,9 +59,9 @@ def report_geom(info, what = ['grid','size','origin','homogenization','microstructures']): """Reports (selected) geometry information""" output = { - 'grid' : 'grid a b c: {}'.format(' x '.join(map(str,info['grid' ]))), - 'size' : 'size x y z: {}'.format(' x '.join(map(str,info['size' ]))), - 'origin' : 'origin x y z: {}'.format(' : '.join(map(str,info['origin']))), + 'grid' : 'grid a b c: {}'.format(' x '.join(list(map(str,info['grid' ])))), + 'size' : 'size x y z: {}'.format(' x '.join(list(map(str,info['size' ])))), + 'origin' : 'origin x y z: {}'.format(' : '.join(list(map(str,info['origin'])))), 'homogenization' : 'homogenization: {}'.format(info['homogenization']), 'microstructures' : 'microstructures: {}'.format(info['microstructures']), } @@ -93,8 +93,10 @@ def execute(cmd, stdout = subprocess.PIPE, stderr = subprocess.PIPE, stdin = subprocess.PIPE) - out,error = [i.replace(b"\x08",b"") for i in (process.communicate() if streamIn is None - else process.communicate(streamIn.read()))] + out,error = [i for i in (process.communicate() if streamIn is None + else process.communicate(streamIn.read().encode('utf-8')))] + out = out.decode('utf-8').replace('\x08','') + error = error.decode('utf-8').replace('\x08','') os.chdir(initialPath) if process.returncode != 0: raise RuntimeError('{} failed with returncode {}'.format(cmd,process.returncode)) return out,error @@ -103,9 +105,9 @@ def coordGridAndSize(coordinates): """Determines grid count and overall physical size along each dimension of an ordered array of coordinates""" dim = coordinates.shape[1] coords = [np.unique(coordinates[:,i]) for i in range(dim)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') + mincorner = np.array(list(map(min,coords))) + maxcorner = np.array(list(map(max,coords))) + grid = np.array(list(map(len,coords)),'i') size = grid/np.maximum(np.ones(dim,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 equal to smallest among other ones return grid,size diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index a21d91064..43717c975 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -75,8 +75,8 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3) - P = np.array(map(float,table.data[column[options.stress ]:column[options.stress ]+9]),'d').reshape(3,3) + F = np.array(list(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9])),'d').reshape(3,3) + P = np.array(list(map(float,table.data[column[options.stress ]:column[options.stress ]+9])),'d').reshape(3,3) table.data_append(list(1.0/np.linalg.det(F)*np.dot(P,F.T).reshape(9))) # [Cauchy] = (1/det(F)) * [P].[F_transpose] outputAlive = table.data_write() # output processed line diff --git a/processing/post/addCompatibilityMismatch.py b/processing/post/addCompatibilityMismatch.py index 51e5f5eab..b798acdbd 100755 --- a/processing/post/addCompatibilityMismatch.py +++ b/processing/post/addCompatibilityMismatch.py @@ -282,19 +282,12 @@ for name in filenames: table.data_readArray([options.defgrad,options.pos]) table.data_rewind() - if len(table.data.shape) < 2: table.data.shape += (1,) # expand to 2D shape if table.data[:,9:].shape[1] < 3: table.data = np.hstack((table.data, np.zeros((table.data.shape[0], 3-table.data[:,9:].shape[1]),dtype='f'))) # fill coords up to 3D with zeros - coords = [np.unique(table.data[:,9+i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings - + grid,size = damask.util.coordGridAndSize(table.data[:,9:12]) N = grid.prod() if N != len(table.data): errors.append('data count {} does not match grid {}x{}x{}.'.format(N,*grid)) diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index 5ca851b22..52a4ae438 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -138,7 +138,6 @@ for name in filenames: # --------------- figure out size and grid --------------------------------------------------------- table.data_readArray() - grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) # ------------------------------------------ process value field ----------------------------------- diff --git a/processing/post/addDeterminant.py b/processing/post/addDeterminant.py index 1f721c27e..6d992b6f5 100755 --- a/processing/post/addDeterminant.py +++ b/processing/post/addDeterminant.py @@ -58,7 +58,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -81,12 +81,11 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: - table.data_append(determinant(map(float,table.data[column: - column+data['dim']]))) + table.data_append(determinant(list(map(float,table.data[column: column+data['dim']])))) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- - table.close() # close input ASCII table (works for stdin) \ No newline at end of file + table.close() # close input ASCII table (works for stdin) diff --git a/processing/post/addDeviator.py b/processing/post/addDeviator.py index 471c2635f..86fcac509 100755 --- a/processing/post/addDeviator.py +++ b/processing/post/addDeviator.py @@ -66,7 +66,7 @@ for name in filenames: remarks = [] column = {} - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type)) @@ -83,7 +83,7 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): + for type, data in items.items(): for label in data['active']: table.labels_append(['{}_dev({})'.format(i+1,label) for i in range(data['dim'])] + \ (['sph({})'.format(label)] if options.spherical else [])) # extend ASCII header with new labels @@ -93,10 +93,10 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: - table.data_append(deviator(map(float,table.data[column: - column+data['dim']]),options.spherical)) + table.data_append(deviator(list(map(float,table.data[column: + column+data['dim']])),options.spherical)) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/processing/post/addDisplacement.py b/processing/post/addDisplacement.py index bc1d7377b..00132d7c6 100755 --- a/processing/post/addDisplacement.py +++ b/processing/post/addDisplacement.py @@ -168,13 +168,7 @@ for name in filenames: np.zeros((table.data.shape[0], 3-table.data[:,9:].shape[1]),dtype='f'))) # fill coords up to 3D with zeros - coords = [np.unique(table.data[:,9+i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings - + grid,size = damask.util.coordGridAndSize(table.data[:,9:12]) N = grid.prod() if N != len(table.data): errors.append('data count {} does not match grid {}x{}x{}.'.format(N,*grid)) diff --git a/processing/post/addEhkl.py b/processing/post/addEhkl.py index f7a143466..59f678118 100755 --- a/processing/post/addEhkl.py +++ b/processing/post/addEhkl.py @@ -88,9 +88,9 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table for column in columns: - table.data_append(E_hkl(map(float,table.data[column:column+3]),options.hkl)) + table.data_append(E_hkl(list(map(float,table.data[column:column+3])),options.hkl)) outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- - table.close() # close ASCII tables \ No newline at end of file + table.close() # close ASCII tables diff --git a/processing/post/addEuclideanDistance.py b/processing/post/addEuclideanDistance.py index b83c36b6c..d99eaaa8c 100755 --- a/processing/post/addEuclideanDistance.py +++ b/processing/post/addEuclideanDistance.py @@ -102,7 +102,7 @@ parser.add_option('-t', help = 'feature type {{{}}} '.format(', '.join(map(lambda x:'/'.join(x['names']),features))) ) parser.add_option('-n', '--neighborhood', - dest = 'neighborhood', choices = neighborhoods.keys(), metavar = 'string', + dest = 'neighborhood', choices = list(neighborhoods.keys()), metavar = 'string', help = 'neighborhood type [neumann] {{{}}}'.format(', '.join(neighborhoods.keys()))) parser.add_option('-s', '--scale', @@ -151,10 +151,8 @@ for name in filenames: remarks = [] column = {} - coordDim = table.label_dimension(options.pos) - if not 3 >= coordDim >= 1: + if not 3 >= table.label_dimension(options.pos) >= 1: errors.append('coordinates "{}" need to have one, two, or three dimensions.'.format(options.pos)) - else: coordCol = table.label_index(options.pos) if table.label_dimension(options.id) != 1: errors.append('grain identifier {} not found.'.format(options.id)) else: idCol = table.label_index(options.id) @@ -178,11 +176,7 @@ for name in filenames: table.data_readArray() - coords = [np.unique(table.data[:,coordCol+i]) for i in range(coordDim)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords)+[1]*(3-len(coords)),'i') - + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) N = grid.prod() if N != len(table.data): errors.append('data count {} does not match grid {}.'.format(N,'x'.join(map(str,grid)))) diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index c198ef62f..bc0100f56 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -83,7 +83,7 @@ for name in filenames: if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) else: colCoord = table.label_index(options.pos) - for type, data in items.iteritems(): + for type, data in items.items(): for what in (data['labels'] if data['labels'] is not None else []): dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type)) @@ -100,7 +100,7 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): + for type, data in items.items(): for label in data['active']: table.labels_append(['Gauss{}({})'.format(options.sigma,label)]) # extend ASCII header with new labels table.head_write() @@ -114,7 +114,7 @@ for name in filenames: # ------------------------------------------ process value field ----------------------------------- stack = [table.data] - for type, data in items.iteritems(): + for type, data in items.items(): for i,label in enumerate(data['active']): stack.append(ndimage.filters.gaussian_filter(table.data[:,data['column'][i]], options.sigma,options.order, diff --git a/processing/post/addIPFcolor.py b/processing/post/addIPFcolor.py index 2fcc000e1..fd93b45a0 100755 --- a/processing/post/addIPFcolor.py +++ b/processing/post/addIPFcolor.py @@ -116,18 +116,18 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians, + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians, symmetry = options.symmetry).reduced() elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(), + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(), symmetry = options.symmetry).reduced() elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3), + table.data[column[2]:column[2]+3]))).reshape(3,3), symmetry = options.symmetry).reduced() elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])), + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))), symmetry = options.symmetry).reduced() table.data_append(o.IPFcolor(pole)) diff --git a/processing/post/addMises.py b/processing/post/addMises.py index 2ce350dbd..4719c2e35 100755 --- a/processing/post/addMises.py +++ b/processing/post/addMises.py @@ -70,7 +70,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -94,7 +94,7 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: table.data_append(Mises(type, np.array(table.data[column:column+data['dim']],'d').reshape(data['shape']))) diff --git a/processing/post/addOrientations.py b/processing/post/addOrientations.py index dc23b351e..e7948c842 100755 --- a/processing/post/addOrientations.py +++ b/processing/post/addOrientations.py @@ -80,7 +80,7 @@ parser.set_defaults(output = [], (options, filenames) = parser.parse_args() -options.output = map(lambda x: x.lower(), options.output) +options.output = list(map(lambda x: x.lower(), options.output)) if options.output == [] or (not set(options.output).issubset(set(outputChoices))): parser.error('output must be chosen from {}.'.format(', '.join(outputChoices))) @@ -147,21 +147,21 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians, + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians, symmetry = options.symmetry).reduced() elif inputtype == 'rodrigues': - o = damask.Orientation(Rodrigues= np.array(map(float,table.data[column:column+3])), + o = damask.Orientation(Rodrigues= np.array(list(map(float,table.data[column:column+3]))), symmetry = options.symmetry).reduced() elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(), + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(), symmetry = options.symmetry).reduced() elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ - table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3), + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ + table.data[column[1]:column[1]+3] + \ + table.data[column[2]:column[2]+3]))).reshape(3,3), symmetry = options.symmetry).reduced() elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])), + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))), symmetry = options.symmetry).reduced() o.quaternion = r*o.quaternion*R # apply additional lab and crystal frame rotations diff --git a/processing/post/addPK2.py b/processing/post/addPK2.py index 9e6308c39..82898efde 100755 --- a/processing/post/addPK2.py +++ b/processing/post/addPK2.py @@ -75,8 +75,8 @@ for name in filenames: # ------------------------------------------ process data ------------------------------------------ outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - F = np.array(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9]),'d').reshape(3,3) - P = np.array(map(float,table.data[column[options.stress ]:column[options.stress ]+9]),'d').reshape(3,3) + F = np.array(list(map(float,table.data[column[options.defgrad]:column[options.defgrad]+9])),'d').reshape(3,3) + P = np.array(list(map(float,table.data[column[options.stress ]:column[options.stress ]+9])),'d').reshape(3,3) table.data_append(list(np.dot(np.linalg.inv(F),P).reshape(9))) # [S] =[P].[F-1] outputAlive = table.data_write() # output processed line diff --git a/processing/post/addPole.py b/processing/post/addPole.py index 10c5cce67..95bc87637 100755 --- a/processing/post/addPole.py +++ b/processing/post/addPole.py @@ -120,15 +120,15 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians) + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians) elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose()) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose()) elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ - table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3)) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ + table.data[column[1]:column[1]+3] + \ + table.data[column[2]:column[2]+3]))).reshape(3,3)) elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4]))) + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4])))) rotatedPole = o.quaternion*pole # rotate pole according to crystal orientation (x,y) = rotatedPole[0:2]/(1.+abs(pole[2])) # stereographic projection diff --git a/processing/post/addSchmidfactors.py b/processing/post/addSchmidfactors.py index 4f34621b7..81f240ac1 100755 --- a/processing/post/addSchmidfactors.py +++ b/processing/post/addSchmidfactors.py @@ -252,15 +252,15 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table if inputtype == 'eulers': - o = damask.Orientation(Eulers = np.array(map(float,table.data[column:column+3]))*toRadians,) + o = damask.Orientation(Eulers = np.array(list(map(float,table.data[column:column+3])))*toRadians,) elif inputtype == 'matrix': - o = damask.Orientation(matrix = np.array(map(float,table.data[column:column+9])).reshape(3,3).transpose(),) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column:column+9]))).reshape(3,3).transpose(),) elif inputtype == 'frame': - o = damask.Orientation(matrix = np.array(map(float,table.data[column[0]:column[0]+3] + \ - table.data[column[1]:column[1]+3] + \ - table.data[column[2]:column[2]+3])).reshape(3,3),) + o = damask.Orientation(matrix = np.array(list(map(float,table.data[column[0]:column[0]+3] + \ + table.data[column[1]:column[1]+3] + \ + table.data[column[2]:column[2]+3]))).reshape(3,3),) elif inputtype == 'quaternion': - o = damask.Orientation(quaternion = np.array(map(float,table.data[column:column+4])),) + o = damask.Orientation(quaternion = np.array(list(map(float,table.data[column:column+4]))),) rotForce = o.quaternion.conjugated() * force rotNormal = o.quaternion.conjugated() * normal diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index 76bf2e875..6eea8bee2 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -58,7 +58,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -84,9 +84,9 @@ for name in filenames: outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table - for type, data in items.iteritems(): + for type, data in items.items(): for column in data['column']: - (u,v) = np.linalg.eigh(np.array(map(float,table.data[column:column+data['dim']])).reshape(data['shape'])) + (u,v) = np.linalg.eigh(np.array(list(map(float,table.data[column:column+data['dim']]))).reshape(data['shape'])) if options.rh and np.dot(np.cross(v[:,0], v[:,1]), v[:,2]) < 0.0 : v[:, 2] *= -1.0 # ensure right-handed eigenvector basis table.data_append(list(u)) # vector of max,mid,min eigval table.data_append(list(v.transpose().reshape(data['dim']))) # 3x3=9 combo vector of max,mid,min eigvec coordinates diff --git a/processing/post/addStrainTensors.py b/processing/post/addStrainTensors.py index 447ae03ba..14d66d5f6 100755 --- a/processing/post/addStrainTensors.py +++ b/processing/post/addStrainTensors.py @@ -101,7 +101,7 @@ for name in filenames: errors = [] remarks = [] - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}...'.format(what,type)) @@ -132,7 +132,7 @@ for name in filenames: while outputAlive and table.data_read(): # read next data line of ASCII table for column in items['tensor']['column']: # loop over all requested defgrads - F = np.array(map(float,table.data[column:column+items['tensor']['dim']]),'d').reshape(items['tensor']['shape']) + F = np.array(list(map(float,table.data[column:column+items['tensor']['dim']])),'d').reshape(items['tensor']['shape']) (U,S,Vh) = np.linalg.svd(F) # singular value decomposition R = np.dot(U,Vh) # rotation of polar decomposition stretch['U'] = np.dot(np.linalg.inv(R),F) # F = RU diff --git a/processing/post/averageDown.py b/processing/post/averageDown.py index 886083428..501ca3b3c 100755 --- a/processing/post/averageDown.py +++ b/processing/post/averageDown.py @@ -76,7 +76,6 @@ for name in filenames: remarks = [] if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) if remarks != []: damask.util.croak(remarks) if errors != []: @@ -94,14 +93,7 @@ for name in filenames: table.data_readArray() if (any(options.grid) == 0 or any(options.size) == 0.0): - coords = [np.unique(table.data[:,colCoord+i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings - delta = size/np.maximum(np.ones(3,'d'), grid) - origin = mincorner - 0.5*delta # shift from cell center to corner + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) else: grid = np.array(options.grid,'i') @@ -129,16 +121,15 @@ for name in filenames: #--- generate grid -------------------------------------------------------------------------------- - if colCoord: - x = (0.5 + shift[0] + np.arange(packedGrid[0],dtype=float))/packedGrid[0]*size[0] + origin[0] - y = (0.5 + shift[1] + np.arange(packedGrid[1],dtype=float))/packedGrid[1]*size[1] + origin[1] - z = (0.5 + shift[2] + np.arange(packedGrid[2],dtype=float))/packedGrid[2]*size[2] + origin[2] + x = (0.5 + shift[0] + np.arange(packedGrid[0],dtype=float))/packedGrid[0]*size[0] + origin[0] + y = (0.5 + shift[1] + np.arange(packedGrid[1],dtype=float))/packedGrid[1]*size[1] + origin[1] + z = (0.5 + shift[2] + np.arange(packedGrid[2],dtype=float))/packedGrid[2]*size[2] + origin[2] - xx = np.tile( x, packedGrid[1]* packedGrid[2]) - yy = np.tile(np.repeat(y,packedGrid[0] ),packedGrid[2]) - zz = np.repeat(z,packedGrid[0]*packedGrid[1]) + xx = np.tile( x, packedGrid[1]* packedGrid[2]) + yy = np.tile(np.repeat(y,packedGrid[0] ),packedGrid[2]) + zz = np.repeat(z,packedGrid[0]*packedGrid[1]) - table.data[:,colCoord:colCoord+3] = np.squeeze(np.dstack((xx,yy,zz))) + table.data[:,table.label_indexragen(options.pos)] = np.squeeze(np.dstack((xx,yy,zz))) # ------------------------------------------ output result ----------------------------------------- diff --git a/processing/post/blowUp.py b/processing/post/blowUp.py index 0642deab1..5a0d631e0 100755 --- a/processing/post/blowUp.py +++ b/processing/post/blowUp.py @@ -64,7 +64,6 @@ for name in filenames: remarks = [] if table.label_dimension(options.pos) != 3: errors.append('coordinates "{}" are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) colElem = table.label_index('elem') @@ -79,12 +78,7 @@ for name in filenames: table.data_readArray(options.pos) table.data_rewind() - coords = [np.unique(table.data[:,i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') - size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) - size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings + grid,size = damask.util.coordGridAndSize(table.data) packing = np.array(options.packing,'i') outSize = grid*packing @@ -113,7 +107,7 @@ for name in filenames: for c in range(outSize[2]): for b in range(outSize[1]): for a in range(outSize[0]): - data[a,b,c,colCoord:colCoord+3] = [a+0.5,b+0.5,c+0.5]*elementSize + data[a,b,c,table.label_indexrange(options.pos)] = [a+0.5,b+0.5,c+0.5]*elementSize if colElem != -1: data[a,b,c,colElem] = elem table.data = data[a,b,c,:].tolist() outputAlive = table.data_write() # output processed line diff --git a/processing/post/rotateData.py b/processing/post/rotateData.py index 08958cc86..ce8156038 100755 --- a/processing/post/rotateData.py +++ b/processing/post/rotateData.py @@ -73,7 +73,7 @@ for name in filenames: remarks = [] column = {} - for type, data in items.iteritems(): + for type, data in items.items(): for what in data['labels']: dim = table.label_dimension(what) if dim != data['dim']: remarks.append('column {} is not a {}.'.format(what,type)) @@ -100,13 +100,13 @@ for name in filenames: for column in items[datatype]['column']: # loop over all requested labels table.data[column:column+items[datatype]['dim']] = \ - q * np.array(map(float,table.data[column:column+items[datatype]['dim']])) + q * np.array(list(map(float,table.data[column:column+items[datatype]['dim']]))) datatype = 'tensor' for column in items[datatype]['column']: # loop over all requested labels table.data[column:column+items[datatype]['dim']] = \ - np.dot(R,np.dot(np.array(map(float,table.data[column:column+items[datatype]['dim']])).\ + np.dot(R,np.dot(np.array(list(map(float,table.data[column:column+items[datatype]['dim']]))).\ reshape(items[datatype]['shape']),R.transpose())).reshape(items[datatype]['dim']) outputAlive = table.data_write() # output processed line diff --git a/processing/post/vtk2ang.py b/processing/post/vtk2ang.py index 6da07bc02..123dc5b98 100755 --- a/processing/post/vtk2ang.py +++ b/processing/post/vtk2ang.py @@ -421,8 +421,6 @@ for filename in filenames: meshActor.GetProperty().SetOpacity(0.2) meshActor.GetProperty().SetColor(1.0,1.0,0) meshActor.GetProperty().BackfaceCullingOn() - # meshActor.GetProperty().SetEdgeColor(1,1,0.5) - # meshActor.GetProperty().EdgeVisibilityOn() boxpoints = vtk.vtkPoints() for n in range(8): diff --git a/processing/post/vtk_rectilinearGrid.py b/processing/post/vtk_rectilinearGrid.py index 326f26046..d01d118cb 100755 --- a/processing/post/vtk_rectilinearGrid.py +++ b/processing/post/vtk_rectilinearGrid.py @@ -82,7 +82,7 @@ for name in filenames: [coords[i][j-1] + coords[i][j] for j in range(1,len(coords[i]))] + \ [3.0 * coords[i][-1] - coords[i][-1 - int(len(coords[i]) > 1)]]) for i in range(3)] - grid = np.array(map(len,coords),'i') + grid = np.array(list(map(len,coords)),'i') N = grid.prod() if options.mode == 'point' else (grid-1).prod() if N != len(table.data): diff --git a/processing/pre/geom_fromOsteonGeometry.py b/processing/pre/geom_fromOsteonGeometry.py index 716a43615..807e5200e 100755 --- a/processing/pre/geom_fromOsteonGeometry.py +++ b/processing/pre/geom_fromOsteonGeometry.py @@ -55,9 +55,9 @@ parser.set_defaults(canal = 25e-6, (options,filename) = parser.parse_args() -if np.any(options.grid < 2): +if np.any(np.array(options.grid) < 2): parser('invalid grid a b c.') -if np.any(options.size <= 0.0): +if np.any(np.array(options.size) <= 0.0): parser('invalid size x y z.') # --- open input files ---------------------------------------------------------------------------- @@ -114,12 +114,8 @@ for y in range(info['grid'][1]): info['microstructures'] += 1 #--- report --------------------------------------------------------------------------------------- -damask.util.croak(['grid a b c: %s'%(' x '.join(map(str,info['grid']))), - 'size x y z: %s'%(' x '.join(map(str,info['size']))), - 'origin x y z: %s'%(' : '.join(map(str,info['origin']))), - 'homogenization: %i'%info['homogenization'], - 'microstructures: %i'%info['microstructures']]) -# -------------------------------------- switch according to task ---------------------------------- +damask.util.report_geom(info,['grid','size','origin','homogenization','microstructures']) + formatwidth = 1+int(math.floor(math.log10(info['microstructures']-1))) header = [scriptID + ' ' + ' '.join(sys.argv[1:])] header.append('') diff --git a/processing/pre/geom_fromTable.py b/processing/pre/geom_fromTable.py index b10bc9f88..33b75b307 100755 --- a/processing/pre/geom_fromTable.py +++ b/processing/pre/geom_fromTable.py @@ -1,7 +1,7 @@ #!/usr/bin/env python2.7 # -*- coding: UTF-8 no BOM -*- -import os,sys,math,types,time +import os,sys,math,time import scipy.spatial, numpy as np from optparse import OptionParser import damask @@ -152,7 +152,7 @@ for name in filenames: continue table.data_readArray([options.pos] \ - + ([label] if isinstance(label, types.StringTypes) else label) \ + + (label if isinstance(label, list) else [label]) \ + ([options.phase] if options.phase else [])) if coordDim == 2: @@ -165,9 +165,9 @@ for name in filenames: # --------------- figure out size and grid --------------------------------------------------------- coords = [np.unique(table.data[:,i]) for i in range(3)] - mincorner = np.array(map(min,coords)) - maxcorner = np.array(map(max,coords)) - grid = np.array(map(len,coords),'i') + mincorner = np.array(list(map(min,coords))) + maxcorner = np.array(list(map(max,coords))) + grid = np.array(list(map(len,coords)),'i') size = grid/np.maximum(np.ones(3,'d'), grid-1.0) * (maxcorner-mincorner) # size from edge to edge = dim * n/(n-1) size = np.where(grid > 1, size, min(size[grid > 1]/grid[grid > 1])) # spacing for grid==1 set to smallest among other spacings delta = size/np.maximum(np.ones(3,'d'), grid) diff --git a/processing/pre/geom_fromVoronoiTessellation.py b/processing/pre/geom_fromVoronoiTessellation.py index 4dcb5b40f..f57f1d35e 100755 --- a/processing/pre/geom_fromVoronoiTessellation.py +++ b/processing/pre/geom_fromVoronoiTessellation.py @@ -15,8 +15,7 @@ scriptID = ' '.join([scriptName,damask.version]) def meshgrid2(*arrs): """Code inspired by http://stackoverflow.com/questions/1827489/numpy-meshgrid-in-3d""" arrs = tuple(reversed(arrs)) - arrs = tuple(arrs) - lens = np.array(map(len, arrs)) + lens = np.array(list(map(len, arrs))) dim = len(arrs) ans = [] for i, arr in enumerate(arrs): diff --git a/processing/pre/geom_translate.py b/processing/pre/geom_translate.py index f8f6e4169..2f4918632 100755 --- a/processing/pre/geom_translate.py +++ b/processing/pre/geom_translate.py @@ -92,7 +92,7 @@ for name in filenames: } substituted = np.copy(microstructure) - for k, v in sub.iteritems(): substituted[microstructure==k] = v # substitute microstructure indices + for k, v in sub.items(): substituted[microstructure==k] = v # substitute microstructure indices substituted += options.microstructure # shift microstructure indices diff --git a/processing/pre/hybridIA_linODFsampling.py b/processing/pre/hybridIA_linODFsampling.py index e4735674a..d1b0efd57 100755 --- a/processing/pre/hybridIA_linODFsampling.py +++ b/processing/pre/hybridIA_linODFsampling.py @@ -270,7 +270,7 @@ for name in filenames: ODF['limit'] = np.radians(limits[1,:]) # right hand limits in radians ODF['center'] = 0.0 if all(limits[0,:]<1e-8) else 0.5 # vertex or cell centered - ODF['interval'] = np.array(map(len,[np.unique(table.data[:,i]) for i in range(3)]),'i') # steps are number of distict values + ODF['interval'] = np.array(list(map(len,[np.unique(table.data[:,i]) for i in range(3)])),'i') # steps are number of distict values ODF['nBins'] = ODF['interval'].prod() ODF['delta'] = np.radians(np.array(limits[1,0:3]-limits[0,0:3])/(ODF['interval']-1)) # step size diff --git a/processing/pre/mentat_spectralBox.py b/processing/pre/mentat_spectralBox.py index 16c982f82..0299b35dc 100755 --- a/processing/pre/mentat_spectralBox.py +++ b/processing/pre/mentat_spectralBox.py @@ -77,7 +77,14 @@ def mesh(r,d): "%f %f %f"%(-d[0],d[1],d[2]), "%f %f %f"%(-d[0],d[1],0.0), "*add_elements", - range(1,9), + "1", + "2", + "3", + "4", + "5", + "6", + "7", + "8", "*sub_divisions", "%i %i %i"%(r[2],r[1],r[0]), "*subdivide_elements", @@ -201,7 +208,7 @@ if options.port: except: parser.error('no valid Mentat release found.') -# --- loop over input files ------------------------------------------------------------------------- +# --- loop over input files ------------------------------------------------------------------------ if filenames == []: filenames = [None] @@ -236,7 +243,7 @@ for name in filenames: # --- read data ------------------------------------------------------------------------------------ - microstructure = table.microstructure_read(info['grid']).reshape(info['grid'].prod(),order='F') # read microstructure + microstructure = table.microstructure_read(info['grid']).reshape(info['grid'].prod(),order='F') # read microstructure cmds = [\ init(), diff --git a/processing/pre/patchFromReconstructedBoundaries.py b/processing/pre/patchFromReconstructedBoundaries.py index a43ccc236..fabec0fdf 100755 --- a/processing/pre/patchFromReconstructedBoundaries.py +++ b/processing/pre/patchFromReconstructedBoundaries.py @@ -344,7 +344,7 @@ def rcbParser(content,M,size,tolerance,idcolumn,segmentcolumn): else: myNeighbors[grainNeighbors[leg][side]] = 1 if myNeighbors: # do I have any neighbors (i.e., non-bounding box segment) - candidateGrains = sorted(myNeighbors.iteritems(), key=lambda p: (p[1],p[0]), reverse=True) # sort grain counting + candidateGrains = sorted(myNeighbors.items(), key=lambda p: (p[1],p[0]), reverse=True) # sort grain counting # most frequent one not yet seen? rcData['grainMapping'].append(candidateGrains[0 if candidateGrains[0][0] not in rcData['grainMapping'] else 1][0]) # must be me then # special case of bi-crystal situation... diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 9418cd56d..97c23f6cd 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -17,13 +17,7 @@ list(APPEND OBJECTFILES $) add_library(PREC OBJECT "prec.f90") list(APPEND OBJECTFILES $) -if (PROJECT_NAME STREQUAL "DAMASK_spectral") - add_library(DAMASK_INTERFACE OBJECT "spectral_interface.f90") -elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") - add_library(DAMASK_INTERFACE OBJECT "FEM_interface.f90") -else () - message (FATAL_ERROR "Build target (PROJECT_NAME) is not defined") -endif() +add_library(DAMASK_INTERFACE OBJECT "DAMASK_interface.f90") add_dependencies(DAMASK_INTERFACE PREC SYSTEM_ROUTINES) list(APPEND OBJECTFILES $) @@ -31,8 +25,12 @@ add_library(IO OBJECT "IO.f90") add_dependencies(IO DAMASK_INTERFACE) list(APPEND OBJECTFILES $) +add_library(HDF5_UTILITIES OBJECT "HDF5_utilities.f90") +add_dependencies(HDF5_UTILITIES IO) +list(APPEND OBJECTFILES $) + add_library(NUMERICS OBJECT "numerics.f90") -add_dependencies(NUMERICS IO) +add_dependencies(NUMERICS HDF5_UTILITIES) list(APPEND OBJECTFILES $) add_library(DEBUG OBJECT "debug.f90") @@ -57,7 +55,7 @@ if (PROJECT_NAME STREQUAL "DAMASK_spectral") add_dependencies(MESH DAMASK_MATH) list(APPEND OBJECTFILES $) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") - add_library(FEZoo OBJECT "FEZoo.f90") + add_library(FEZoo OBJECT "FEM_zoo.f90") add_dependencies(FEZoo DAMASK_MATH) list(APPEND OBJECTFILES $) add_library(MESH OBJECT "meshFEM.f90") @@ -175,25 +173,24 @@ if (PROJECT_NAME STREQUAL "DAMASK_spectral") "spectral_mech_Basic.f90") add_dependencies(SPECTRAL_SOLVER SPECTRAL_UTILITIES) list(APPEND OBJECTFILES $) + if(NOT CMAKE_BUILD_TYPE STREQUAL "SYNTAXONLY") add_executable(DAMASK_spectral "DAMASK_spectral.f90" ${OBJECTFILES}) else() add_library(DAMASK_spectral OBJECT "DAMASK_spectral.f90") endif() + add_dependencies(DAMASK_spectral SPECTRAL_SOLVER) elseif (PROJECT_NAME STREQUAL "DAMASK_FEM") add_library(FEM_UTILITIES OBJECT "FEM_utilities.f90") add_dependencies(FEM_UTILITIES DAMASK_CPFE) + list(APPEND OBJECTFILES $) add_library(FEM_SOLVER OBJECT - "FEM_hydrogenflux.f90" - "FEM_porosity.f90" - "FEM_vacancyflux.f90" - "FEM_damage.f90" - "FEM_thermal.f90" "FEM_mech.f90") add_dependencies(FEM_SOLVER FEM_UTILITIES) + list(APPEND OBJECTFILES $) - add_executable(DAMASK_FEM "DAMASK_FEM_driver.f90") + add_executable(DAMASK_FEM "DAMASK_FEM.f90" ${OBJECTFILES}) add_dependencies(DAMASK_FEM FEM_SOLVER) endif() diff --git a/src/CPFEM2.f90 b/src/CPFEM2.f90 index c66aa4089..89e65f5fd 100644 --- a/src/CPFEM2.f90 +++ b/src/CPFEM2.f90 @@ -50,8 +50,8 @@ subroutine CPFEM_initAll(el,ip) IO_init use DAMASK_interface #ifdef FEM - use FEZoo, only: & - FEZoo_init + use FEM_Zoo, only: & + FEM_Zoo_init #endif implicit none @@ -62,7 +62,7 @@ subroutine CPFEM_initAll(el,ip) call prec_init call IO_init #ifdef FEM - call FEZoo_init + call FEM_Zoo_init #endif call numerics_init call debug_init @@ -196,7 +196,7 @@ end subroutine CPFEM_init !-------------------------------------------------------------------------------------------------- -!> @brief perform initialization at first call, update variables and call the actual material model +!> @brief forwards data after successful increment !-------------------------------------------------------------------------------------------------- subroutine CPFEM_age() use prec, only: & @@ -212,16 +212,6 @@ subroutine CPFEM_age() debug_levelSelective use FEsolving, only: & restartWrite - use math, only: & - math_identity2nd, & - math_mul33x33, & - math_det33, & - math_transpose33, & - math_I3, & - math_Mandel3333to66, & - math_Mandel66to3333, & - math_Mandel33to6, & - math_Mandel6to33 use material, only: & plasticState, & sourceState, & diff --git a/src/DAMASK_FEM.f90 b/src/DAMASK_FEM.f90 new file mode 100644 index 000000000..ee425585c --- /dev/null +++ b/src/DAMASK_FEM.f90 @@ -0,0 +1,654 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Driver controlling inner and outer load case looping of the FEM solver +!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing +!> results +!-------------------------------------------------------------------------------------------------- +program DAMASK_FEM + use, intrinsic :: & + iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) + use prec, only: & + pInt, & + pReal, & + tol_math_check + use DAMASK_interface, only: & + DAMASK_interface_init, & + loadCaseFile, & + getSolverJobName + use IO, only: & + IO_read, & + IO_isBlank, & + IO_open_file, & + IO_stringPos, & + IO_stringValue, & + IO_floatValue, & + IO_intValue, & + IO_error, & + IO_lc, & + IO_intOut, & + IO_warning, & + IO_timeStamp, & + IO_EOF + use debug, only: & + debug_level, & + debug_spectral, & + debug_levelBasic + use math ! need to include the whole module for FFTW + use CPFEM2, only: & + CPFEM_initAll + use FEsolving, only: & + restartWrite, & + restartInc + use numerics, only: & + maxCutBack, & + stagItMax, & + worldrank + use mesh, only: & + mesh_Nboundaries, & + mesh_boundaries, & + geomMesh + use FEM_Utilities, only: & + utilities_init, & + tSolutionState, & + tLoadCase, & + cutBack, & + maxFields, & + nActiveFields, & + FIELD_MECH_ID, & + FIELD_THERMAL_ID, & + FIELD_DAMAGE_ID, & + FIELD_SOLUTE_ID, & + FIELD_MGTWIN_ID, & + COMPONENT_MECH_X_ID, & + COMPONENT_MECH_Y_ID, & + COMPONENT_MECH_Z_ID, & + COMPONENT_THERMAL_T_ID, & + COMPONENT_DAMAGE_PHI_ID, & + COMPONENT_SOLUTE_CV_ID, & + COMPONENT_SOLUTE_CVPOT_ID, & + COMPONENT_SOLUTE_CH_ID, & + COMPONENT_SOLUTE_CHPOT_ID, & + COMPONENT_SOLUTE_CVaH_ID, & + COMPONENT_SOLUTE_CVaHPOT_ID, & + COMPONENT_MGTWIN_PHI_ID, & + FIELD_MECH_label, & + FIELD_THERMAL_label, & + FIELD_DAMAGE_label, & + FIELD_SOLUTE_label, & + FIELD_MGTWIN_label + use FEM_mech + + implicit none +#include + +!-------------------------------------------------------------------------------------------------- +! variables related to information from load case and geom file + integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature + integer(pInt), allocatable, dimension(:) :: chunkPos ! this is longer than needed for geometry parsing + + integer(pInt) :: & + N_def = 0_pInt !< # of rate of deformation specifiers found in load case file + character(len=65536) :: & + line + +!-------------------------------------------------------------------------------------------------- +! loop variables, convergence etc. + + integer(pInt), parameter :: & + subStepFactor = 2_pInt !< for each substep, divide the last time increment by 2.0 + real(pReal) :: & + time = 0.0_pReal, & !< elapsed time + time0 = 0.0_pReal, & !< begin of interval + timeinc = 0.0_pReal, & !< current time interval + timeIncOld = 0.0_pReal, & !< previous time interval + remainingLoadCaseTime = 0.0_pReal !< remaining time of current load case + logical :: & + guess !< guess along former trajectory + integer(pInt) :: & + i, & + errorID, & + cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ + stepFraction = 0_pInt !< fraction of current time interval + integer(pInt) :: & + currentLoadcase = 0_pInt, & !< current load case + currentFace = 0_pInt, & + inc, & !< current increment in current load case + totalIncsCounter = 0_pInt, & !< total No. of increments + convergedCounter = 0_pInt, & !< No. of converged increments + notConvergedCounter = 0_pInt, & !< No. of non-converged increments + statUnit = 0_pInt, & !< file unit for statistics output + lastRestartWritten = 0_pInt !< total increment No. at which last restart information was written + integer(pInt) :: & + stagIter, & + component + logical :: & + stagIterate + character(len=6) :: loadcase_string + character(len=1024) :: incInfo !< string parsed to solution with information about current load case + type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases + type(tSolutionState), allocatable, dimension(:) :: solres + PetscInt :: faceSet, currentFaceSet + PetscInt :: field, dimPlex + PetscErrorCode :: ierr + + external :: & + MPI_abort, & + DMGetDimension, & + DMGetLabelSize, & + DMGetLabelIdIS, & + ISDestroy, & + quit +!-------------------------------------------------------------------------------------------------- +! init DAMASK (all modules) + call CPFEM_initAll(el = 1_pInt, ip = 1_pInt) + write(6,'(/,a)') ' <<<+- DAMASK_FEM init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + +! reading basic information from load case file and allocate data structure containing load cases + call DMGetDimension(geomMesh,dimPlex,ierr)! CHKERRQ(ierr) !< dimension of mesh (2D or 3D) + nActiveFields = 1 + allocate(solres(nActiveFields)) + +!-------------------------------------------------------------------------------------------------- +! reading basic information from load case file and allocate data structure containing load cases + call IO_open_file(FILEUNIT,trim(loadCaseFile)) + rewind(FILEUNIT) + do + line = IO_read(FILEUNIT) + if (trim(line) == IO_EOF) exit + if (IO_isBlank(line)) cycle ! skip empty lines + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase + select case (IO_lc(IO_stringValue(line,chunkPos,i))) + case('$loadcase') + N_def = N_def + 1_pInt + end select + enddo ! count all identifiers to allocate memory and do sanity check + enddo + + 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) + case(FIELD_MECH_ID) + loadCases(i)%fieldBC(field)%nComponents = dimPlex !< X, Y (, Z) displacements + allocate(loadCases(i)%fieldBC(field)%componentBC(loadCases(i)%fieldBC(field)%nComponents)) + 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 + +!-------------------------------------------------------------------------------------------------- +! reading the load case and assign values to the allocated data structure + rewind(FILEUNIT) + do + line = IO_read(FILEUNIT) + if (trim(line) == IO_EOF) exit + if (IO_isBlank(line)) cycle ! skip empty lines + chunkPos = IO_stringPos(line) + do i = 1_pInt, chunkPos(1) + select case (IO_lc(IO_stringValue(line,chunkPos,i))) +!-------------------------------------------------------------------------------------------------- +! loadcase information + case('$loadcase') + currentLoadCase = IO_intValue(line,chunkPos,i+1_pInt) + case('face') + currentFace = IO_intValue(line,chunkPos,i+1_pInt) + currentFaceSet = -1_pInt + do faceSet = 1, mesh_Nboundaries + if (mesh_boundaries(faceSet) == currentFace) currentFaceSet = faceSet + enddo + if (currentFaceSet < 0_pInt) call IO_error(error_ID = errorID, ext_msg = 'invalid BC') + case('t','time','delta') ! increment time + loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) + case('n','incs','increments','steps') ! number of increments + loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) + case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) + loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) + loadCases(currentLoadCase)%logscale = 1_pInt + case('freq','frequency','outputfreq') ! frequency of result writings + loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + case('r','restart','restartwrite') ! frequency of writing restart information + loadCases(currentLoadCase)%restartfrequency = & + max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) + case('guessreset','dropguessing') + loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory + +!-------------------------------------------------------------------------------------------------- +! boundary condition information + case('x') ! X displacement field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_X_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('y') ! Y displacement field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Y_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('z') ! Z displacement field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MECH_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MECH_Z_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('temp','temperature') ! thermal field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_THERMAL_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_THERMAL_T_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('mgtwin') ! mgtwin field + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_MGTWIN_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_MGTWIN_PHI_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('damage') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_DAMAGE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_DAMAGE_PHI_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cv') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CV_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cvpot') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVPOT_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('ch') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CH_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('chpot') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CHPOT_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cvah') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVaH_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + case('cvahpot') + do field = 1, nActiveFields + if (loadCases(currentLoadCase)%fieldBC(field)%ID == FIELD_SOLUTE_ID) then + do component = 1, loadcases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%ID == COMPONENT_SOLUTE_CVaHPOT_ID) then + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask (currentFaceSet) = & + .true. + loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Value(currentFaceSet) = & + IO_floatValue(line,chunkPos,i+1_pInt) + endif + enddo + endif + enddo + + end select + enddo; enddo + close(FILEUNIT) + +!-------------------------------------------------------------------------------------------------- +! consistency checks and output of load case + loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase + errorID = 0_pInt + if (worldrank == 0) then + checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases) + write (loadcase_string, '(i6)' ) currentLoadCase + write(6,'(1x,a,i6)') 'load case: ', currentLoadCase + if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & + write(6,'(2x,a)') 'drop guessing along trajectory' + do field = 1_pInt, nActiveFields + select case (loadCases(currentLoadCase)%fieldBC(field)%ID) + case(FIELD_MECH_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_MECH_label) + + case(FIELD_THERMAL_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_THERMAL_label) + + case(FIELD_DAMAGE_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_DAMAGE_label) + + case(FIELD_MGTWIN_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_MGTWIN_label) + + case(FIELD_SOLUTE_ID) + write(6,'(2x,a)') 'Field '//trim(FIELD_SOLUTE_label) + + end select + do faceSet = 1_pInt, mesh_Nboundaries + do component = 1_pInt, loadCases(currentLoadCase)%fieldBC(field)%nComponents + if (loadCases(currentLoadCase)%fieldBC(field)%componentBC(component)%Mask(faceSet)) & + write(6,'(4x,a,i2,a,i2,a,f12.7)') 'Face ', mesh_boundaries(faceSet), & + ' Component ', component, & + ' Value ', loadCases(currentLoadCase)%fieldBC(field)% & + componentBC(component)%Value(faceSet) + enddo + enddo + enddo + write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time + if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs + if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + write(6,'(2x,a,i5)') 'output frequency: ', & + loadCases(currentLoadCase)%outputfrequency + write(6,'(2x,a,i5,/)') 'restart frequency: ', & + loadCases(currentLoadCase)%restartfrequency + if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message + enddo checkLoadcases + endif + +!-------------------------------------------------------------------------------------------------- +! doing initialization depending on selected solver + call Utilities_init() + do field = 1, nActiveFields + select case (loadCases(1)%fieldBC(field)%ID) + case(FIELD_MECH_ID) + call FEM_mech_init(loadCases(1)%fieldBC(field)) + end select + enddo + +!-------------------------------------------------------------------------------------------------- +! loopping over loadcases + loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) + time0 = time ! currentLoadCase start time + if (loadCases(currentLoadCase)%followFormerTrajectory) then + guess = .true. + else + guess = .false. ! change of load case, homogeneous guess for the first inc + endif + +!-------------------------------------------------------------------------------------------------- +! loop oper incs defined in input file for current currentLoadCase + incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs + totalIncsCounter = totalIncsCounter + 1_pInt + +!-------------------------------------------------------------------------------------------------- +! forwarding time + timeIncOld = timeinc + if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale + timeinc = loadCases(currentLoadCase)%time/loadCases(currentLoadCase)%incs ! only valid for given linear time scale. will be overwritten later in case loglinear scale is used + else + if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale + if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale + timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd + else ! not-1st inc of 1st currentLoadCase of logarithmic scale + timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) + endif + else ! not-1st currentLoadCase of logarithmic scale + timeinc = time0 * & + ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc,pReal)/& + real(loadCases(currentLoadCase)%incs ,pReal))& + -(1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( (inc-1_pInt),pReal)/& + real(loadCases(currentLoadCase)%incs ,pReal))) + endif + endif + timeinc = timeinc / 2.0_pReal**real(cutBackLevel,pReal) ! depending on cut back level, decrease time step + + forwarding: if(totalIncsCounter >= restartInc) then + stepFraction = 0_pInt + +!-------------------------------------------------------------------------------------------------- +! loop over sub incs + subIncLooping: do while (stepFraction/subStepFactor**cutBackLevel <1_pInt) + time = time + timeinc ! forward time + stepFraction = stepFraction + 1_pInt + remainingLoadCaseTime = time0 - time + loadCases(currentLoadCase)%time + timeInc + +!-------------------------------------------------------------------------------------------------- +! report begin of new increment + if (worldrank == 0) then + write(6,'(/,a)') ' ###########################################################################' + write(6,'(1x,a,es12.5'//& + ',a,'//IO_intOut(inc)//',a,'//IO_intOut(loadCases(currentLoadCase)%incs)//& + ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//& + ',a,'//IO_intOut(currentLoadCase)//',a,'//IO_intOut(size(loadCases))//')') & + 'Time', time, & + 's: Increment ', inc, '/', loadCases(currentLoadCase)%incs,& + '-', stepFraction, '/', subStepFactor**cutBackLevel,& + ' of load case ', currentLoadCase,'/',size(loadCases) + flush(6) + write(incInfo,'(a,'//IO_intOut(totalIncsCounter)//',a,'//IO_intOut(sum(loadCases%incs))//& + ',a,'//IO_intOut(stepFraction)//',a,'//IO_intOut(subStepFactor**cutBackLevel)//')') & + 'Increment ',totalIncsCounter,'/',sum(loadCases%incs),& + '-',stepFraction, '/', subStepFactor**cutBackLevel + endif + +!-------------------------------------------------------------------------------------------------- +! forward fields + do field = 1, nActiveFields + select case (loadCases(currentLoadCase)%fieldBC(field)%ID) + case(FIELD_MECH_ID) + call FEM_mech_forward (& + guess,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) + + end select + enddo + +!-------------------------------------------------------------------------------------------------- +! solve fields + stagIter = 0_pInt + stagIterate = .true. + do while (stagIterate) + do field = 1, nActiveFields + select case (loadCases(currentLoadCase)%fieldBC(field)%ID) + case(FIELD_MECH_ID) + solres(field) = FEM_mech_solution (& + incInfo,timeinc,timeIncOld,loadCases(currentLoadCase)%fieldBC(field)) + + end select + if(.not. solres(field)%converged) exit ! no solution found + enddo + stagIter = stagIter + 1_pInt + stagIterate = stagIter < stagItMax .and. & + all(solres(:)%converged) .and. & + .not. all(solres(:)%stagConverged) + enddo + +! check solution + cutBack = .False. + if(.not. all(solres(:)%converged .and. solres(:)%stagConverged)) then ! no solution found + if (cutBackLevel < maxCutBack) then ! do cut back + if (worldrank == 0) & + write(6,'(/,a)') ' cut back detected' + cutBack = .True. + stepFraction = (stepFraction - 1_pInt) * subStepFactor ! adjust to new denominator + cutBackLevel = cutBackLevel + 1_pInt + time = time - timeinc ! rewind time + timeinc = timeinc/2.0_pReal + else ! default behavior, exit if spectral solver does not converge + call IO_warning(850_pInt) + call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written (e.g. for regridding) ! continue from non-converged solution and start guessing after accepted (sub)inc + endif + else + guess = .true. ! start guessing after first converged (sub)inc + timeIncOld = timeinc + endif + if (.not. cutBack) then + if (worldrank == 0) write(statUnit,*) totalIncsCounter, time, cutBackLevel, & + solres%converged, solres%iterationsNeeded ! write statistics about accepted solution + endif + enddo subIncLooping + cutBackLevel = max(0_pInt, cutBackLevel - 1_pInt) ! try half number of subincs next inc + if(all(solres(:)%converged)) then ! report converged inc + convergedCounter = convergedCounter + 1_pInt + if (worldrank == 0) then + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & + ' increment ', totalIncsCounter, ' converged' + endif + else + if (worldrank == 0) then + write(6,'(/,a,'//IO_intOut(totalIncsCounter)//',a)') & ! report non-converged inc + ' increment ', totalIncsCounter, ' NOT converged' + endif + notConvergedCounter = notConvergedCounter + 1_pInt + endif; flush(6) + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency + if (worldrank == 0) then + write(6,'(1/,a)') ' ... writing results to file ......................................' + endif + endif + if( loadCases(currentLoadCase)%restartFrequency > 0_pInt .and. & ! at frequency of writing restart information set restart parameter for FEsolving + mod(inc,loadCases(currentLoadCase)%restartFrequency) == 0_pInt) then ! ToDo first call to CPFEM_general will write? + restartWrite = .true. + lastRestartWritten = inc + endif + else forwarding + time = time + timeinc + guess = .true. + endif forwarding + + enddo incLooping + enddo loadCaseLooping + +!-------------------------------------------------------------------------------------------------- +! report summary of whole calculation + if (worldrank == 0) then + write(6,'(/,a)') ' ###########################################################################' + write(6,'(1x,i6.6,a,i6.6,a,f5.1,a)') convergedCounter, ' out of ', & + notConvergedCounter + convergedCounter, ' (', & + real(convergedCounter, pReal)/& + real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & + ' %) increments converged!' + endif + if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged + call quit(0_pInt) ! no complains ;) + +end program DAMASK_FEM + + +!-------------------------------------------------------------------------------------------------- +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief quit subroutine to mimic behavior of FEM solvers +!> @details exits the Spectral solver and reports time and duration. Exit code 0 signals +!> everything went fine. Exit code 1 signals an error, message according to IO_error. Exit code +!> 2 signals request for regridding, increment of last saved restart information is written to +!> stderr. Exit code 3 signals no severe problems, but some increments did not converge +!-------------------------------------------------------------------------------------------------- +subroutine quit(stop_id) + use prec, only: & + pInt + + implicit none + integer(pInt), intent(in) :: stop_id + integer, dimension(8) :: dateAndTime ! type default integer + + call date_and_time(values = dateAndTime) + write(6,'(/,a)') 'DAMASK terminated on:' + write(6,'(a,2(i2.2,a),i4.4)') 'Date: ',dateAndTime(3),'/',& + dateAndTime(2),'/',& + dateAndTime(1) + write(6,'(a,2(i2.2,a),i2.2)') 'Time: ',dateAndTime(5),':',& + dateAndTime(6),':',& + dateAndTime(7) + if (stop_id == 0_pInt) stop 0 ! normal termination + if (stop_id < 0_pInt) then ! trigger regridding + write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) + stop 2 + endif + if (stop_id == 3_pInt) stop 3 ! not all incs converged + stop 1 ! error (message from IO_error) + +end subroutine quit diff --git a/src/DAMASK_abaqus.f b/src/DAMASK_abaqus.f index e91cbb0bb..69f6fba4b 100644 --- a/src/DAMASK_abaqus.f +++ b/src/DAMASK_abaqus.f @@ -3,38 +3,42 @@ !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Koen Janssens, Paul Scherrer Institut !> @author Arun Prakash, Fraunhofer IWM +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief interfaces DAMASK with Abaqus/Standard !> @details put the included file abaqus_v6.env in either your home or model directory, !> it is a minimum Abaqus environment file containing all changes necessary to use the !> DAMASK subroutine (see Abaqus documentation for more information on the use of abaqus_v6.env) !-------------------------------------------------------------------------------------------------- - -#ifndef INT -#define INT 4 -#endif - -#ifndef FLOAT -#define FLOAT 8 -#endif - #define Abaqus #include "prec.f90" module DAMASK_interface -implicit none -character(len=4), dimension(2), parameter :: INPUTFILEEXTENSION = ['.pes','.inp'] -character(len=4), parameter :: LOGFILEEXTENSION = '.log' + implicit none + private + character(len=4), dimension(2), parameter, public :: INPUTFILEEXTENSION = ['.pes','.inp'] + character(len=4), parameter, public :: LOGFILEEXTENSION = '.log' + + public :: & + DAMASK_interface_init, & + getSolverJobName contains !-------------------------------------------------------------------------------------------------- -!> @brief just reporting +!> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init + use ifport, only: & + CHDIR + + implicit none integer, dimension(8) :: & dateAndTime ! type default integer + integer :: lenOutDir,ierr + character(len=256) :: wd + call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_abaqus_std -+>>>' write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' @@ -46,26 +50,19 @@ subroutine DAMASK_interface_init dateAndTime(6),':',& dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + + call getoutdir(wd, lenOutDir) + ierr = CHDIR(wd) + if (ierr /= 0) then + write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' + call quit(1) + endif + #include "compilation_info.f90" end subroutine DAMASK_interface_init -!-------------------------------------------------------------------------------------------------- -!> @brief using Abaqus/Standard function to get working directory name -!-------------------------------------------------------------------------------------------------- -character(1024) function getSolverWorkingDirectoryName() - - implicit none - integer :: lenOutDir - - getSolverWorkingDirectoryName='' - call getoutdir(getSolverWorkingDirectoryName, lenOutDir) - getSolverWorkingDirectoryName=trim(getSolverWorkingDirectoryName)//'/' - -end function getSolverWorkingDirectoryName - - !-------------------------------------------------------------------------------------------------- !> @brief using Abaqus/Standard function to get solver job name !-------------------------------------------------------------------------------------------------- @@ -79,10 +76,17 @@ character(1024) function getSolverJobName() end function getSolverJobName + end module DAMASK_interface -#include "commercialFEM_fileList.f90" + + +#include "commercialFEM_fileList.f90" + +!-------------------------------------------------------------------------------------------------- +!> @brief This is the Abaqus std user subroutine for defining material behavior +!-------------------------------------------------------------------------------------------------- subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,& RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,& TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,& diff --git a/src/spectral_interface.f90 b/src/DAMASK_interface.f90 similarity index 60% rename from src/spectral_interface.f90 rename to src/DAMASK_interface.f90 index d2adcf9ba..02a1ad1d8 100644 --- a/src/spectral_interface.f90 +++ b/src/DAMASK_interface.f90 @@ -1,12 +1,13 @@ !-------------------------------------------------------------------------------------------------- +!> @author Jaeyong Jung, Max-Planck-Institut für Eisenforschung GmbH +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Interfacing between the spectral solver and the material subroutines provided +!> @brief Interfacing between the PETSc-based solvers and the material subroutines provided !! by DAMASK -!> @details Interfacing between the spectral solver and the material subroutines provided -!> by DAMASK. Interpretating the command line arguments or, in case of called from f2py, -!> the arguments parsed to the init routine to get load case, geometry file, working -!> directory, etc. +!> @details Interfacing between the PETSc-based solvers and the material subroutines provided +!> by DAMASK. Interpretating the command line arguments to get load case, geometry file, +!> and working directory. !-------------------------------------------------------------------------------------------------- module DAMASK_interface use prec, only: & @@ -14,26 +15,23 @@ module DAMASK_interface implicit none private - logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) - integer(pInt), public, protected :: spectralRestartInc = 0_pInt !< Increment at which calculation starts + integer(pInt), public, protected :: & + interface_restartInc = 0_pInt !< Increment at which calculation starts character(len=1024), public, protected :: & geometryFile = '', & !< parameter given for geometry file loadCaseFile = '' !< parameter given for load case file - character(len=1024), private :: workingDirectory !< accessed by getSolverWorkingDirectoryName for compatibility reasons public :: & - getSolverWorkingDirectoryName, & getSolverJobName, & DAMASK_interface_init private :: & - storeWorkingDirectory, & + setWorkingDirectory, & getGeometryFile, & getLoadCaseFile, & rectifyPath, & makeRelativePath, & IIO_stringValue, & IIO_intValue, & - IIO_lc, & IIO_stringPos contains @@ -46,23 +44,37 @@ subroutine DAMASK_interface_init() iso_fortran_env #include #if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=9 -=================================================================================================== +=================================================================================================== + 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x +=================================================================================================== +======= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =========================================== +========== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ======================================== +============= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ===================================== +================ THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ================================== +=================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =============================== +====================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ============================ ========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========================= +============================ THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ====================== +=============================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x =================== +================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ================ +===================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ============= +======================================== THIS VERSION OF DAMASK REQUIRES PETSc 3.9.x ========== +=================================================================================================== + 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x 3.9.x =================================================================================================== #endif use PETScSys use system_routines, only: & - getHostName + getHostName, & + getCWD implicit none character(len=1024) :: & commandLine, & !< command line call as string - loadCaseArg ='', & !< -l argument given to DAMASK_spectral.exe - geometryArg ='', & !< -g argument given to DAMASK_spectral.exe - workingDirArg ='', & !< -w argument given to DAMASK_spectral.exe - hostName, & !< name of machine on which DAMASK_spectral.exe is execute (might require export HOSTNAME) - userName, & !< name of user calling DAMASK_spectral.exe - tag + loadcaseArg = '', & !< -l argument given to the executable + geometryArg = '', & !< -g argument given to the executable + workingDirArg = '', & !< -w argument given to the executable + userName !< name of user calling the executable integer :: & i, & #ifdef _OPENMP @@ -75,7 +87,6 @@ subroutine DAMASK_interface_init() integer, dimension(8) :: & dateAndTime ! type default integer PetscErrorCode :: ierr - logical :: error external :: & quit,& PETScErrorF, & ! is called in the CHKERRQ macro @@ -113,8 +124,8 @@ subroutine DAMASK_interface_init() endif mainProcess call date_and_time(values = dateAndTime) - write(6,'(/,a)') ' <<<+- DAMASK_spectral -+>>>' - write(6,'(/,a)') ' Roters et al., Computational Materials Science, 2018' + write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' + write(6,'(a,/)') ' Roters et al., Computational Materials Science, 2018' write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& @@ -123,19 +134,16 @@ subroutine DAMASK_interface_init() dateAndTime(6),':',& dateAndTime(7) write(6,'(/,a,i4.1)') ' MPI processes: ',worldsize - write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' #include "compilation_info.f90" call get_command(commandLine) chunkPos = IIO_stringPos(commandLine) - do i = 1, chunkPos(1) - tag = IIO_lc(IIO_stringValue(commandLine,chunkPos,i)) ! extract key - select case(tag) + do i = 2_pInt, chunkPos(1) + select case(IIO_stringValue(commandLine,chunkPos,i)) ! extract key case ('-h','--help') write(6,'(a)') ' #######################################################################' - write(6,'(a)') ' DAMASK_spectral:' - write(6,'(a)') ' The spectral method boundary value problem solver for' - write(6,'(a)') ' the Düsseldorf Advanced Material Simulation Kit' + write(6,'(a)') ' DAMASK Command Line Interface:' + write(6,'(a)') ' For PETSc-based solvers for the Düsseldorf Advanced Material Simulation Kit' write(6,'(a,/)')' #######################################################################' write(6,'(a,/)')' Valid command line switches:' write(6,'(a)') ' --geom (-g, --geometry)' @@ -145,23 +153,14 @@ subroutine DAMASK_interface_init() write(6,'(a)') ' --help (-h)' write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Mandatory arguments:' - write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom.geom' - write(6,'(a)') ' Specifies the location of the geometry definition file,' - write(6,'(a)') ' if no extension is given, .geom will be appended.' - write(6,'(a)') ' "PathToGeomFile" will be the working directory if not specified' - write(6,'(a)') ' via --workingdir.' - write(6,'(a)') ' Make sure the file "material.config" exists in the working' - write(6,'(a)') ' directory.' - write(6,'(a)') ' For further configuration place "numerics.config"' - write(6,'(a)')' and "numerics.config" in that directory.' - write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile.load' - write(6,'(a)') ' Specifies the location of the load case definition file,' - write(6,'(a)') ' if no extension is given, .load will be appended.' + write(6,'(/,a)')' --geom PathToGeomFile/NameOfGeom' + write(6,'(a)') ' Specifies the location of the geometry definition file.' + write(6,'(/,a)')' --load PathToLoadFile/NameOfLoadFile' + write(6,'(a)') ' Specifies the location of the load case definition file.' write(6,'(/,a)')' -----------------------------------------------------------------------' write(6,'(a)') ' Optional arguments:' write(6,'(/,a)')' --workingdirectory PathToWorkingDirectory' - write(6,'(a)') ' Specifies the working directory and overwrites the default' - write(6,'(a)') ' "PathToGeomFile".' + write(6,'(a)') ' Specifies the working directory and overwrites the default ./' write(6,'(a)') ' Make sure the file "material.config" exists in the working' write(6,'(a)') ' directory.' write(6,'(a)') ' For further configuration place "numerics.config"' @@ -170,7 +169,7 @@ subroutine DAMASK_interface_init() write(6,'(a)') ' Reads in increment XX and continues with calculating' write(6,'(a)') ' increment XX+1 based on this.' write(6,'(a)') ' Appends to existing results file' - write(6,'(a)') ' "NameOfGeom_NameOfLoadFile.spectralOut".' + write(6,'(a)') ' "NameOfGeom_NameOfLoadFile".' write(6,'(a)') ' Works only if the restart information for increment XX' write(6,'(a)') ' is available in the working directory.' write(6,'(/,a)')' -----------------------------------------------------------------------' @@ -179,42 +178,42 @@ subroutine DAMASK_interface_init() write(6,'(a,/)')' Prints this message and exits' call quit(0_pInt) ! normal Termination case ('-l', '--load', '--loadcase') - loadcaseArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if ( i < chunkPos(1)) loadcaseArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-g', '--geom', '--geometry') - geometryArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if (i < chunkPos(1)) geometryArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-w', '-d', '--wd', '--directory', '--workingdir', '--workingdirectory') - workingDirArg = IIO_stringValue(commandLine,chunkPos,i+1_pInt) + if (i < chunkPos(1)) workingDirArg = trim(IIO_stringValue(commandLine,chunkPos,i+1_pInt)) case ('-r', '--rs', '--restart') - spectralRestartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) - appendToOutFile = .true. + if (i < chunkPos(1)) then + interface_restartInc = IIO_IntValue(commandLine,chunkPos,i+1_pInt) + endif end select enddo - - if (len(trim(loadcaseArg)) == 0 .or. len(trim(geometryArg)) == 0) then + + if (len_trim(loadcaseArg) == 0 .or. len_trim(geometryArg) == 0) then write(6,'(a)') ' Please specify geometry AND load case (-h for help)' call quit(1_pInt) endif - workingDirectory = trim(storeWorkingDirectory(trim(workingDirArg),trim(geometryArg))) + if (len_trim(workingDirArg) > 0) call setWorkingDirectory(trim(workingDirArg)) geometryFile = getGeometryFile(geometryArg) loadCaseFile = getLoadCaseFile(loadCaseArg) call get_environment_variable('USER',userName) - error = getHostName(hostName) - write(6,'(a,a)') ' Host name: ', trim(hostName) + ! 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,a)') ' User name: ', trim(userName) write(6,'(a,a)') ' Command line call: ', trim(commandLine) if (len(trim(workingDirArg)) > 0) & write(6,'(a,a)') ' Working dir argument: ', trim(workingDirArg) write(6,'(a,a)') ' Geometry argument: ', trim(geometryArg) write(6,'(a,a)') ' Loadcase argument: ', trim(loadcaseArg) - write(6,'(a,a)') ' Working directory: ', trim(getSolverWorkingDirectoryName()) + write(6,'(a,a)') ' Working directory: ', trim(getCWD()) write(6,'(a,a)') ' Geometry file: ', trim(geometryFile) write(6,'(a,a)') ' Loadcase file: ', trim(loadCaseFile) write(6,'(a,a)') ' Solver job name: ', trim(getSolverJobName()) - if (SpectralRestartInc > 0_pInt) & - write(6,'(a,i6.6)') ' Restart from increment: ', spectralRestartInc - write(6,'(a,l1,/)') ' Append to result file: ', appendToOutFile + if (interface_restartInc > 0_pInt) & + write(6,'(a,i6.6)') ' Restart from increment: ', interface_restartInc end subroutine DAMASK_interface_init @@ -222,59 +221,33 @@ end subroutine DAMASK_interface_init !-------------------------------------------------------------------------------------------------- !> @brief extract working directory from given argument or from location of geometry file, !! possibly converting relative arguments to absolut path -!> @todo change working directory with call chdir(storeWorkingDirectory)? !-------------------------------------------------------------------------------------------------- -character(len=1024) function storeWorkingDirectory(workingDirectoryArg,geometryArg) +subroutine setWorkingDirectory(workingDirectoryArg) use system_routines, only: & - isDirectory, & - getCWD + getCWD, & + setCWD implicit none character(len=*), intent(in) :: workingDirectoryArg !< working directory argument - character(len=*), intent(in) :: geometryArg !< geometry argument - character(len=1024) :: cwd - logical :: error + character(len=1024) :: workingDirectory !< working directory argument external :: quit + logical :: error - wdGiven: if (len(workingDirectoryArg)>0) then - absolutePath: if (workingDirectoryArg(1:1) == '/') then - storeWorkingDirectory = workingDirectoryArg - else absolutePath - error = getCWD(cwd) - if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/'//workingDirectoryArg - endif absolutePath - if (storeWorkingDirectory(len(trim(storeWorkingDirectory)):len(trim(storeWorkingDirectory))) /= '/') & - storeWorkingDirectory = trim(storeWorkingDirectory)//'/' ! if path seperator is not given, append it - else wdGiven - if (geometryArg(1:1) == '/') then ! absolute path given as command line argument - storeWorkingDirectory = geometryArg(1:scan(geometryArg,'/',back=.true.)) - else - error = getCWD(cwd) ! relative path given as command line argument - if (error) call quit(1_pInt) - storeWorkingDirectory = trim(cwd)//'/'//geometryArg(1:scan(geometryArg,'/',back=.true.)) - endif - endif wdGiven + absolutePath: if (workingDirectoryArg(1:1) == '/') then + workingDirectory = workingDirectoryArg + else absolutePath + workingDirectory = getCWD() + workingDirectory = trim(workingDirectory)//'/'//workingDirectoryArg + endif absolutePath - storeWorkingDirectory = trim(rectifyPath(storeWorkingDirectory)) - if(.not. isDirectory(trim(storeWorkingDirectory))) then ! check if the directory exists - write(6,'(a20,a,a16)') ' working directory "',trim(storeWorkingDirectory),'" does not exist' - call quit(1_pInt) + workingDirectory = trim(rectifyPath(workingDirectory)) + error = setCWD(trim(workingDirectory)) + if(error) then + write(6,'(a20,a,a16)') ' working directory "',trim(workingDirectory),'" does not exist' + call quit(1_pInt) endif -end function storeWorkingDirectory - - -!-------------------------------------------------------------------------------------------------- -!> @brief simply returns the private string workingDir -!-------------------------------------------------------------------------------------------------- -character(len=1024) function getSolverWorkingDirectoryName() - - implicit none - - getSolverWorkingDirectoryName = workingDirectory - -end function getSolverWorkingDirectoryName +end subroutine setWorkingDirectory !-------------------------------------------------------------------------------------------------- @@ -310,28 +283,12 @@ character(len=1024) function getGeometryFile(geometryParameter) getCWD implicit none - character(len=1024), intent(in) :: & - geometryParameter - character(len=1024) :: & - cwd - integer :: posExt, posSep - logical :: error - external :: quit + character(len=1024), intent(in) :: geometryParameter - getGeometryFile = geometryParameter - posExt = scan(getGeometryFile,'.',back=.true.) - posSep = scan(getGeometryFile,'/',back=.true.) + getGeometryFile = trim(geometryParameter) + if (scan(getGeometryFile,'/') /= 1) getGeometryFile = trim(getCWD())//'/'//trim(getGeometryFile) + getGeometryFile = makeRelativePath(trim(getCWD()), getGeometryFile) - if (posExt <= posSep) getGeometryFile = trim(getGeometryFile)//('.geom') ! no extension present - if (scan(getGeometryFile,'/') /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - if (error) call quit(1_pInt) - getGeometryFile = rectifyPath(trim(cwd)//'/'//getGeometryFile) - else - getGeometryFile = rectifyPath(getGeometryFile) - endif - - getGeometryFile = makeRelativePath(getSolverWorkingDirectoryName(), getGeometryFile) end function getGeometryFile @@ -344,55 +301,45 @@ character(len=1024) function getLoadCaseFile(loadCaseParameter) getCWD implicit none - character(len=1024), intent(in) :: & - loadCaseParameter - character(len=1024) :: & - cwd - integer :: posExt, posSep - logical :: error - external :: quit + character(len=1024), intent(in) :: loadCaseParameter - getLoadCaseFile = loadcaseParameter - posExt = scan(getLoadCaseFile,'.',back=.true.) - posSep = scan(getLoadCaseFile,'/',back=.true.) - - if (posExt <= posSep) getLoadCaseFile = trim(getLoadCaseFile)//('.load') ! no extension present - if (scan(getLoadCaseFile,'/') /= 1) then ! relative path given as command line argument - error = getcwd(cwd) - if (error) call quit(1_pInt) - getLoadCaseFile = rectifyPath(trim(cwd)//'/'//getLoadCaseFile) - else - getLoadCaseFile = rectifyPath(getLoadCaseFile) - endif - - getLoadCaseFile = makeRelativePath(getSolverWorkingDirectoryName(), getLoadCaseFile) + getLoadCaseFile = trim(loadCaseParameter) + if (scan(getLoadCaseFile,'/') /= 1) getLoadCaseFile = trim(getCWD())//'/'//trim(getLoadCaseFile) + getLoadCaseFile = makeRelativePath(trim(getCWD()), getLoadCaseFile) end function getLoadCaseFile !-------------------------------------------------------------------------------------------------- -!> @brief remove ../ and /./ from path +!> @brief remove ../, /./, and // from path. +!> @details works only if absolute path is given !-------------------------------------------------------------------------------------------------- function rectifyPath(path) implicit none character(len=*) :: path - character(len=len_trim(path)) :: rectifyPath + character(len=1024) :: rectifyPath integer :: i,j,k,l ! no pInt !-------------------------------------------------------------------------------------------------- ! remove /./ from path - l = len_trim(path) - rectifyPath = path + rectifyPath = trim(path) + l = len_trim(rectifyPath) do i = l,3,-1 - if (rectifyPath(i-2:i) == '/'//'.'//'/') & - rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + if (rectifyPath(i-2:i) == '/./') rectifyPath(i-1:l) = rectifyPath(i+1:l)//' ' + enddo + +!-------------------------------------------------------------------------------------------------- +! remove // from path + l = len_trim(rectifyPath) + do i = l,2,-1 + if (rectifyPath(i-1:i) == '//') rectifyPath(i-1:l) = rectifyPath(i:l)//' ' enddo !-------------------------------------------------------------------------------------------------- ! remove ../ and corresponding directory from rectifyPath l = len_trim(rectifyPath) - i = index(rectifyPath(i:l),'..'//'/') + i = index(rectifyPath(i:l),'../') j = 0 do while (i > j) j = scan(rectifyPath(1:i-2),'/',back=.true.) @@ -402,7 +349,7 @@ function rectifyPath(path) rectifyPath(j+1:k-1) = rectifyPath(j+2:k) rectifyPath(k:k) = ' ' endif - i = j+index(rectifyPath(j+1:l),'..'//'/') + i = j+index(rectifyPath(j+1:l),'../') enddo if(len_trim(rectifyPath) == 0) rectifyPath = '/' @@ -415,20 +362,24 @@ end function rectifyPath character(len=1024) function makeRelativePath(a,b) implicit none - character (len=*) :: a,b + character (len=*), intent(in) :: a,b + character (len=1024) :: a_cleaned,b_cleaned integer :: i,posLastCommonSlash,remainingSlashes !no pInt posLastCommonSlash = 0 remainingSlashes = 0 + a_cleaned = rectifyPath(trim(a)//'/') + b_cleaned = rectifyPath(b) - do i = 1, min(1024,len_trim(a),len_trim(b)) - if (a(i:i) /= b(i:i)) exit - if (a(i:i) == '/') posLastCommonSlash = i + do i = 1, min(1024,len_trim(a_cleaned),len_trim(rectifyPath(b_cleaned))) + if (a_cleaned(i:i) /= b_cleaned(i:i)) exit + if (a_cleaned(i:i) == '/') posLastCommonSlash = i enddo - do i = posLastCommonSlash+1,len_trim(a) - if (a(i:i) == '/') remainingSlashes = remainingSlashes + 1 + do i = posLastCommonSlash+1,len_trim(a_cleaned) + if (a_cleaned(i:i) == '/') remainingSlashes = remainingSlashes + 1 enddo - makeRelativePath = repeat('..'//'/',remainingSlashes)//b(posLastCommonSlash+1:len_trim(b)) + + makeRelativePath = repeat('..'//'/',remainingSlashes)//b_cleaned(posLastCommonSlash+1:len_trim(b_cleaned)) end function makeRelativePath @@ -439,17 +390,12 @@ end function makeRelativePath pure function IIO_stringValue(string,chunkPos,myChunk) implicit none - integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string - integer(pInt), intent(in) :: myChunk !< position number of desired chunk - character(len=1+chunkPos(myChunk*2+1)-chunkPos(myChunk*2)) :: IIO_stringValue - character(len=*), intent(in) :: string !< raw input with known start and end of each chunk + integer(pInt), dimension(:), intent(in) :: chunkPos !< positions of start and end of each tag/chunk in given string + integer(pInt), intent(in) :: myChunk !< position number of desired chunk + character(len=chunkPos(myChunk*2+1)-chunkPos(myChunk*2)+1) :: IIO_stringValue + character(len=*), intent(in) :: string !< raw input with known start and end of each chunk - - valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then - IIO_stringValue = '' - else valuePresent - IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) - endif valuePresent + IIO_stringValue = string(chunkPos(myChunk*2):chunkPos(myChunk*2+1)) end function IIO_stringValue @@ -476,29 +422,6 @@ integer(pInt) pure function IIO_intValue(string,chunkPos,myChunk) end function IIO_intValue -!-------------------------------------------------------------------------------------------------- -!> @brief taken from IO, check IO_lc for documentation -!-------------------------------------------------------------------------------------------------- -pure function IIO_lc(string) - - implicit none - character(len=*), intent(in) :: string !< string to convert - character(len=len(string)) :: IIO_lc - - character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - - integer :: i,n ! no pInt (len returns default integer) - - IIO_lc = string - do i=1,len(string) - n = index(UPPER,IIO_lc(i:i)) - if (n/=0) IIO_lc(i:i) = LOWER(n:n) - enddo - -end function IIO_lc - - !-------------------------------------------------------------------------------------------------- !> @brief taken from IO, check IO_stringPos for documentation !-------------------------------------------------------------------------------------------------- diff --git a/src/DAMASK_marc.f90 b/src/DAMASK_marc.f90 index 600db3c2e..f3130c5cd 100644 --- a/src/DAMASK_marc.f90 +++ b/src/DAMASK_marc.f90 @@ -1,15 +1,3 @@ -#define QUOTE(x) #x -#define PASTE(x,y) x ## y - -#ifndef INT -#define INT 4 -#endif - -#ifndef FLOAT -#define FLOAT 8 -#endif - -#include "prec.f90" !-------------------------------------------------------------------------------------------------- !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH @@ -17,13 +5,12 @@ !> @author W.A. Counts !> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH !> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Material subroutine for MSC.Marc +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Interfaces DAMASK with MSC.Marc !> @details Usage: !> @details - choose material as hypela2 !> @details - set statevariable 2 to index of homogenization !> @details - set statevariable 3 to index of microstructure -!> @details - make sure the file "material.config" exists in the working directory -!> @details - make sure the file "numerics.config" exists in the working directory !> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse, the latter seems to be faster!) !> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used, i.e uncheck "non-symmetric" !> @details Marc subroutines used: @@ -34,23 +21,36 @@ !> @details - concom: lovl, inc !> @details - creeps: timinc !-------------------------------------------------------------------------------------------------- +#define QUOTE(x) #x +#define PASTE(x,y) x ## y + +#include "prec.f90" + module DAMASK_interface implicit none - character(len=4), parameter :: InputFileExtension = '.dat' - character(len=4), parameter :: LogFileExtension = '.log' + private + character(len=4), parameter, public :: InputFileExtension = '.dat' + character(len=4), parameter, public :: LogFileExtension = '.log' + + public :: & + DAMASK_interface_init, & + getSolverJobName contains - !-------------------------------------------------------------------------------------------------- -!> @brief only output of current version +!> @brief reports and sets working directory !-------------------------------------------------------------------------------------------------- subroutine DAMASK_interface_init + use ifport, only: & + CHDIR implicit none integer, dimension(8) :: & dateAndTime ! type default integer + integer :: ierr + character(len=1024) :: wd call date_and_time(values = dateAndTime) write(6,'(/,a)') ' <<<+- DAMASK_Marc -+>>>' @@ -64,27 +64,17 @@ subroutine DAMASK_interface_init dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' #include "compilation_info.f90" + inquire(5, name=wd) ! determine inputputfile + wd = wd(1:scan(wd,'/',back=.true.)) + ierr = CHDIR(wd) + if (ierr /= 0) then + write(6,'(a20,a,a16)') ' working directory "',trim(wd),'" does not exist' + call quit(1) + endif end subroutine DAMASK_interface_init -!-------------------------------------------------------------------------------------------------- -!> @brief returns the current workingDir -!-------------------------------------------------------------------------------------------------- -function getSolverWorkingDirectoryName() - - implicit none - character(1024) getSolverWorkingDirectoryName, inputName - character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash - - getSolverWorkingDirectoryName='' - inputName='' - inquire(5, name=inputName) ! determine inputputfile - getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.)) - -end function getSolverWorkingDirectoryName - - !-------------------------------------------------------------------------------------------------- !> @brief solver job name (no extension) as combination of geometry and load case name !-------------------------------------------------------------------------------------------------- @@ -109,6 +99,9 @@ end function getSolverJobName end module DAMASK_interface + + + #include "commercialFEM_fileList.f90" !-------------------------------------------------------------------------------------------------- @@ -118,17 +111,6 @@ end module DAMASK_interface !> @details !> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d) !> @details in the parameter section of input deck (updated Lagrangian formulation). -!> @details -!> @details The following operation obtains U (stretch tensor) at t=n+1 : -!> @details -!> @details call scla(un1,0.d0,itel,itel,1) -!> @details do k=1,3 -!> @details do i=1,3 -!> @details do j=1,3 -!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k) -!> @details enddo -!> @details enddo -!> @details enddo !-------------------------------------------------------------------------------------------------- subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, & diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 0d77c57f5..ee5af421c 100644 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -24,13 +24,10 @@ program DAMASK_spectral DAMASK_interface_init, & loadCaseFile, & geometryFile, & - getSolverWorkingDirectoryName, & getSolverJobName, & - appendToOutFile + interface_restartInc use IO, only: & - IO_read, & IO_isBlank, & - IO_open_file, & IO_stringPos, & IO_stringValue, & IO_floatValue, & @@ -39,8 +36,7 @@ program DAMASK_spectral IO_lc, & IO_intOut, & IO_warning, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use debug, only: & debug_level, & debug_spectral, & @@ -91,7 +87,6 @@ program DAMASK_spectral ! variables related to information from load case and geom file real(pReal), dimension(9) :: temp_valueVector = 0.0_pReal !< temporarily from loadcase file when reading in tensors (initialize to 0.0) logical, dimension(9) :: temp_maskVector = .false. !< temporarily from loadcase file when reading in tensors - integer(pInt), parameter :: FILEUNIT = 234_pInt !< file unit, DAMASK IO does not support newunit feature integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & @@ -119,7 +114,7 @@ program DAMASK_spectral stagIterate integer(pInt) :: & i, j, k, l, field, & - errorID, & + errorID = 0_pInt, & cutBackLevel = 0_pInt, & !< cut back level \f$ t = \frac{t_{inc}}{2^l} \f$ stepFraction = 0_pInt !< fraction of current time interval integer(pInt) :: & @@ -128,13 +123,17 @@ program DAMASK_spectral totalIncsCounter = 0_pInt, & !< total # of increments convergedCounter = 0_pInt, & !< # of converged increments notConvergedCounter = 0_pInt, & !< # of non-converged increments - resUnit = 0_pInt, & !< file unit for results writing + fileUnit = 0_pInt, & !< file unit for reading load case and writing results + myStat, & statUnit = 0_pInt, & !< file unit for statistics output lastRestartWritten = 0_pInt, & !< total increment # at which last restart information was written stagIter character(len=6) :: loadcase_string - character(len=1024) :: incInfo !< string parsed to solution with information about current load case + character(len=1024) :: & + incInfo, & !< string parsed to solution with information about current load case + workingDir type(tLoadCase), allocatable, dimension(:) :: loadCases !< array of all load cases + type(tLoadCase) :: newLoadCase type(tSolutionState), allocatable, dimension(:) :: solres integer(MPI_OFFSET_KIND) :: fileOffset integer(MPI_OFFSET_KIND), dimension(:), allocatable :: outputSize @@ -142,6 +141,12 @@ program DAMASK_spectral integer(pInt), parameter :: maxRealOut = maxByteOut/pReal integer(pLongInt), dimension(2) :: outputIndex integer :: ierr + procedure(basic_init), pointer :: & + mech_init + procedure(basic_forward), pointer :: & + mech_forward + procedure(basic_solution), pointer :: & + mech_solution external :: & quit @@ -161,15 +166,40 @@ program DAMASK_spectral if (any(thermal_type == THERMAL_conduction_ID )) nActiveFields = nActiveFields + 1 if (any(damage_type == DAMAGE_nonlocal_ID )) nActiveFields = nActiveFields + 1 allocate(solres(nActiveFields)) + allocate(newLoadCase%ID(nActiveFields)) !-------------------------------------------------------------------------------------------------- -! reading basic information from load case file and allocate data structure containing load cases - call IO_open_file(FILEUNIT,trim(loadCaseFile)) - rewind(FILEUNIT) +! assign mechanics solver depending on selected type + select case (spectral_solver) + case (DAMASK_spectral_SolverBasic_label) + mech_init => basic_init + mech_forward => basic_forward + mech_solution => basic_solution + + case (DAMASK_spectral_SolverPolarisation_label) + if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & + call IO_warning(42_pInt, ext_msg='debug Divergence') + mech_init => polarisation_init + mech_forward => polarisation_forward + mech_solution => polarisation_solution + + case default + call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver)) + + end select + +!-------------------------------------------------------------------------------------------------- +! reading information from load case file and to sanity checks + allocate (loadCases(0)) ! array of load cases + open(newunit=fileunit,iostat=myStat,file=trim(loadCaseFile),action='read') + if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=trim(loadCaseFile)) do - line = IO_read(FILEUNIT) - if (trim(line) == IO_EOF) exit + read(fileUnit, '(A)', iostat=myStat) line + if ( myStat /= 0_pInt) exit if (IO_isBlank(line)) cycle ! skip empty lines + + currentLoadCase = currentLoadCase + 1_pInt + chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) ! reading compulsory parameters for loadcase select case (IO_lc(IO_stringValue(line,chunkPos,i))) @@ -180,83 +210,65 @@ program DAMASK_spectral case('n','incs','increments','steps','logincs','logincrements','logsteps') N_n = N_n + 1_pInt end select - enddo ! count all identifiers to allocate memory and do sanity check - enddo + enddo + if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check + call IO_error(error_ID=837_pInt,el=currentLoadCase,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase - if ((N_def /= N_n) .or. (N_n /= N_t) .or. N_n < 1_pInt) & ! sanity check - call IO_error(error_ID=837_pInt,ext_msg = trim(loadCaseFile)) ! error message for incomplete loadcase - allocate (loadCases(N_n)) ! array of load cases - loadCases%stress%myType='stress' - - do i = 1, size(loadCases) - allocate(loadCases(i)%ID(nActiveFields)) + newLoadCase%stress%myType='stress' field = 1 - loadCases(i)%ID(field) = FIELD_MECH_ID ! mechanical active by default + newLoadCase%ID(field) = FIELD_MECH_ID ! mechanical active by default thermalActive: if (any(thermal_type == THERMAL_conduction_ID)) then field = field + 1 - loadCases(i)%ID(field) = FIELD_THERMAL_ID + newLoadCase%ID(field) = FIELD_THERMAL_ID endif thermalActive damageActive: if (any(damage_type == DAMAGE_nonlocal_ID)) then field = field + 1 - loadCases(i)%ID(field) = FIELD_DAMAGE_ID + newLoadCase%ID(field) = FIELD_DAMAGE_ID endif damageActive - enddo -!-------------------------------------------------------------------------------------------------- -! reading the load case and assign values to the allocated data structure - rewind(FILEUNIT) - do - line = IO_read(FILEUNIT) - if (trim(line) == IO_EOF) exit - if (IO_isBlank(line)) cycle ! skip empty lines - currentLoadCase = currentLoadCase + 1_pInt - chunkPos = IO_stringPos(line) - do i = 1_pInt, chunkPos(1) + readIn: do i = 1_pInt, chunkPos(1) select case (IO_lc(IO_stringValue(line,chunkPos,i))) case('fdot','dotf','l','velocitygrad','velgrad','velocitygradient','f') ! assign values for the deformation BC matrix temp_valueVector = 0.0_pReal if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'fdot'.or. & ! in case of Fdot, set type to fdot IO_lc(IO_stringValue(line,chunkPos,i)) == 'dotf') then - loadCases(currentLoadCase)%deformation%myType = 'fdot' + newLoadCase%deformation%myType = 'fdot' else if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'f') then - loadCases(currentLoadCase)%deformation%myType = 'f' + newLoadCase%deformation%myType = 'f' else - loadCases(currentLoadCase)%deformation%myType = 'l' + newLoadCase%deformation%myType = 'l' endif do j = 1_pInt, 9_pInt temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not a * if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo - loadCases(currentLoadCase)%deformation%maskLogical = & ! logical mask in 3x3 notation - transpose(reshape(temp_maskVector,[ 3,3])) - loadCases(currentLoadCase)%deformation%maskFloat = & ! float (1.0/0.0) mask in 3x3 notation - merge(ones,zeros,loadCases(currentLoadCase)%deformation%maskLogical) - loadCases(currentLoadCase)%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation + newLoadCase%deformation%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) ! logical mask in 3x3 notation + newLoadCase%deformation%maskFloat = merge(ones,zeros,newLoadCase%deformation%maskLogical)! float (1.0/0.0) mask in 3x3 notation + newLoadCase%deformation%values = math_plain9to33(temp_valueVector) ! values in 3x3 notation case('p','pk1','piolakirchhoff','stress', 's') temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt temp_maskVector(j) = IO_stringValue(line,chunkPos,i+j) /= '*' ! true if not an asterisk if (temp_maskVector(j)) temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) ! read value where applicable enddo - loadCases(currentLoadCase)%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) - loadCases(currentLoadCase)%stress%maskFloat = merge(ones,zeros,& - loadCases(currentLoadCase)%stress%maskLogical) - loadCases(currentLoadCase)%stress%values = math_plain9to33(temp_valueVector) + newLoadCase%stress%maskLogical = transpose(reshape(temp_maskVector,[ 3,3])) + newLoadCase%stress%maskFloat = merge(ones,zeros,newLoadCase%stress%maskLogical) + newLoadCase%stress%values = math_plain9to33(temp_valueVector) case('t','time','delta') ! increment time - loadCases(currentLoadCase)%time = IO_floatValue(line,chunkPos,i+1_pInt) + newLoadCase%time = IO_floatValue(line,chunkPos,i+1_pInt) case('n','incs','increments','steps') ! number of increments - loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) case('logincs','logincrements','logsteps') ! number of increments (switch to log time scaling) - loadCases(currentLoadCase)%incs = IO_intValue(line,chunkPos,i+1_pInt) - loadCases(currentLoadCase)%logscale = 1_pInt + newLoadCase%incs = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%logscale = 1_pInt case('freq','frequency','outputfreq') ! frequency of result writings - loadCases(currentLoadCase)%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) + newLoadCase%outputfrequency = IO_intValue(line,chunkPos,i+1_pInt) case('r','restart','restartwrite') ! frequency of writing restart information - loadCases(currentLoadCase)%restartfrequency = & + newLoadCase%restartfrequency = & max(0_pInt,IO_intValue(line,chunkPos,i+1_pInt)) case('guessreset','dropguessing') - loadCases(currentLoadCase)%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory - case('euler') ! rotation of currentLoadCase given in euler angles + newLoadCase%followFormerTrajectory = .false. ! do not continue to predict deformation along former trajectory + case('euler') ! rotation of load case given in euler angles temp_valueVector = 0.0_pReal l = 1_pInt ! assuming values given in degrees k = 1_pInt ! assuming keyword indicating degree/radians present @@ -271,108 +283,90 @@ program DAMASK_spectral temp_valueVector(j) = IO_floatValue(line,chunkPos,i+k+j) enddo if (l == 1_pInt) temp_valueVector(1:3) = temp_valueVector(1:3) * inRad ! convert to rad - loadCases(currentLoadCase)%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix - case('rotation','rot') ! assign values for the rotation of currentLoadCase matrix + newLoadCase%rotation = math_EulerToR(temp_valueVector(1:3)) ! convert rad Eulers to rotation matrix + case('rotation','rot') ! assign values for the rotation matrix temp_valueVector = 0.0_pReal do j = 1_pInt, 9_pInt temp_valueVector(j) = IO_floatValue(line,chunkPos,i+j) enddo - loadCases(currentLoadCase)%rotation = math_plain9to33(temp_valueVector) + newLoadCase%rotation = math_plain9to33(temp_valueVector) end select - enddo; enddo - close(FILEUNIT) - -!-------------------------------------------------------------------------------------------------- -! consistency checks and output of load case - loadCases(1)%followFormerTrajectory = .false. ! cannot guess along trajectory for first inc of first currentLoadCase - errorID = 0_pInt - if (worldrank == 0) then - checkLoadcases: do currentLoadCase = 1_pInt, size(loadCases) + enddo readIn + + newLoadCase%followFormerTrajectory = merge(.true.,.false.,currentLoadCase > 1_pInt) ! by default, guess from previous load case + + reportAndCheck: if (worldrank == 0) then write (loadcase_string, '(i6)' ) currentLoadCase write(6,'(1x,a,i6)') 'load case: ', currentLoadCase - if (.not. loadCases(currentLoadCase)%followFormerTrajectory) & - write(6,'(2x,a)') 'drop guessing along trajectory' - if (loadCases(currentLoadCase)%deformation%myType == 'l') then + if (.not. newLoadCase%followFormerTrajectory) write(6,'(2x,a)') 'drop guessing along trajectory' + if (newLoadCase%deformation%myType == 'l') then do j = 1_pInt, 3_pInt - if (any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & - any(loadCases(currentLoadCase)%deformation%maskLogical(j,1:3) .eqv. .false.)) & - errorID = 832_pInt ! each row should be either fully or not at all defined + if (any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .true.) .and. & + any(newLoadCase%deformation%maskLogical(j,1:3) .eqv. .false.)) errorID = 832_pInt ! each row should be either fully or not at all defined enddo write(6,'(2x,a)') 'velocity gradient:' - else if (loadCases(currentLoadCase)%deformation%myType == 'f') then + else if (newLoadCase%deformation%myType == 'f') then write(6,'(2x,a)') 'deformation gradient at end of load case:' else write(6,'(2x,a)') 'deformation gradient rate:' endif do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt - if(loadCases(currentLoadCase)%deformation%maskLogical(i,j)) then - write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%deformation%values(i,j) + if(newLoadCase%deformation%maskLogical(i,j)) then + write(6,'(2x,f12.7)',advance='no') newLoadCase%deformation%values(i,j) else write(6,'(2x,12a)',advance='no') ' * ' endif enddo; write(6,'(/)',advance='no') enddo - if (any(loadCases(currentLoadCase)%stress%maskLogical .eqv. & - loadCases(currentLoadCase)%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only - if (any(loadCases(currentLoadCase)%stress%maskLogical .and. & - transpose(loadCases(currentLoadCase)%stress%maskLogical) .and. & + if (any(newLoadCase%stress%maskLogical .eqv. & + newLoadCase%deformation%maskLogical)) errorID = 831_pInt ! exclusive or masking only + if (any(newLoadCase%stress%maskLogical .and. & + transpose(newLoadCase%stress%maskLogical) .and. & reshape([ .false.,.true.,.true.,.true.,.false.,.true.,.true.,.true.,.false.],[ 3,3]))) & errorID = 838_pInt ! no rotation is allowed by stress BC write(6,'(2x,a)') 'stress / GPa:' do i = 1_pInt, 3_pInt; do j = 1_pInt, 3_pInt - if(loadCases(currentLoadCase)%stress%maskLogical(i,j)) then - write(6,'(2x,f12.7)',advance='no') loadCases(currentLoadCase)%stress%values(i,j)*1e-9_pReal + if(newLoadCase%stress%maskLogical(i,j)) then + write(6,'(2x,f12.7)',advance='no') newLoadCase%stress%values(i,j)*1e-9_pReal else write(6,'(2x,12a)',advance='no') ' * ' endif enddo; write(6,'(/)',advance='no') enddo - if (any(abs(math_mul33x33(loadCases(currentLoadCase)%rotation, & - math_transpose33(loadCases(currentLoadCase)%rotation))-math_I3) > & + if (any(abs(math_mul33x33(newLoadCase%rotation, & + transpose(newLoadCase%rotation))-math_I3) > & reshape(spread(tol_math_check,1,9),[ 3,3]))& - .or. abs(math_det33(loadCases(currentLoadCase)%rotation)) > & + .or. abs(math_det33(newLoadCase%rotation)) > & 1.0_pReal + tol_math_check) errorID = 846_pInt ! given rotation matrix contains strain - if (any(dNeq(loadCases(currentLoadCase)%rotation, math_I3))) & + if (any(dNeq(newLoadCase%rotation, math_I3))) & write(6,'(2x,a,/,3(3(3x,f12.7,1x)/))',advance='no') 'rotation of loadframe:',& - math_transpose33(loadCases(currentLoadCase)%rotation) - if (loadCases(currentLoadCase)%time < 0.0_pReal) errorID = 834_pInt ! negative time increment - write(6,'(2x,a,f12.6)') 'time: ', loadCases(currentLoadCase)%time - if (loadCases(currentLoadCase)%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count - write(6,'(2x,a,i5)') 'increments: ', loadCases(currentLoadCase)%incs - if (loadCases(currentLoadCase)%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency - write(6,'(2x,a,i5)') 'output frequency: ', & - loadCases(currentLoadCase)%outputfrequency - write(6,'(2x,a,i5,/)') 'restart frequency: ', & - loadCases(currentLoadCase)%restartfrequency + transpose(newLoadCase%rotation) + if (newLoadCase%time < 0.0_pReal) errorID = 834_pInt ! negative time increment + write(6,'(2x,a,f12.6)') 'time: ', newLoadCase%time + if (newLoadCase%incs < 1_pInt) errorID = 835_pInt ! non-positive incs count + write(6,'(2x,a,i5)') 'increments: ', newLoadCase%incs + if (newLoadCase%outputfrequency < 1_pInt) errorID = 836_pInt ! non-positive result frequency + write(6,'(2x,a,i5)') 'output frequency: ', newLoadCase%outputfrequency + write(6,'(2x,a,i5,/)') 'restart frequency: ', newLoadCase%restartfrequency if (errorID > 0_pInt) call IO_error(error_ID = errorID, ext_msg = loadcase_string) ! exit with error message - enddo checkLoadcases - endif + endif reportAndCheck + loadCases = [loadCases,newLoadCase] ! load case is ok, append it + enddo + close(fileUnit) !-------------------------------------------------------------------------------------------------- -! doing initialization depending on selected solver +! doing initialization depending on active solvers call Utilities_init() do field = 1, nActiveFields select case (loadCases(1)%ID(field)) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - call basic_init - - case (DAMASK_spectral_SolverPolarisation_label) - if(iand(debug_level(debug_spectral),debug_levelBasic)/= 0) & - call IO_warning(42_pInt, ext_msg='debug Divergence') - call Polarisation_init - - case default - call IO_error(error_ID = 891_pInt, ext_msg = trim(spectral_solver)) - - end select + call mech_init - case(FIELD_THERMAL_ID) + case(FIELD_THERMAL_ID) call spectral_thermal_init case(FIELD_DAMAGE_ID) - call spectral_damage_init() + call spectral_damage_init end select enddo @@ -380,33 +374,33 @@ program DAMASK_spectral !-------------------------------------------------------------------------------------------------- ! write header of output file if (worldrank == 0) then - if (.not. appendToOutFile) then ! after restart, append to existing results file - open(newunit=resUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + writeHeader: if (interface_restartInc < 1_pInt) then + open(newunit=fileUnit,file=trim(getSolverJobName())//& '.spectralOut',form='UNFORMATTED',status='REPLACE') - write(resUnit) 'load:', trim(loadCaseFile) ! ... and write header - write(resUnit) 'workingdir:', trim(getSolverWorkingDirectoryName()) - write(resUnit) 'geometry:', trim(geometryFile) - write(resUnit) 'grid:', grid - write(resUnit) 'size:', geomSize - write(resUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults - write(resUnit) 'loadcases:', size(loadCases) - write(resUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase - write(resUnit) 'times:', loadCases%time ! one entry per LoadCase - write(resUnit) 'logscales:', loadCases%logscale - write(resUnit) 'increments:', loadCases%incs ! one entry per LoadCase - write(resUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc - write(resUnit) 'eoh' - close(resUnit) ! end of header - open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + write(fileUnit) 'load:', trim(loadCaseFile) ! ... and write header + write(fileUnit) 'workingdir:', trim(workingDir) + write(fileUnit) 'geometry:', trim(geometryFile) + write(fileUnit) 'grid:', grid + write(fileUnit) 'size:', geomSize + write(fileUnit) 'materialpoint_sizeResults:', materialpoint_sizeResults + write(fileUnit) 'loadcases:', size(loadCases) + write(fileUnit) 'frequencies:', loadCases%outputfrequency ! one entry per LoadCase + write(fileUnit) 'times:', loadCases%time ! one entry per LoadCase + write(fileUnit) 'logscales:', loadCases%logscale + write(fileUnit) 'increments:', loadCases%incs ! one entry per LoadCase + write(fileUnit) 'startingIncrement:', restartInc ! start with writing out the previous inc + write(fileUnit) 'eoh' + close(fileUnit) ! end of header + open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED',status='REPLACE') write(statUnit,'(a)') 'Increment Time CutbackLevel Converged IterationsNeeded' ! statistics file if (iand(debug_level(debug_spectral),debug_levelBasic) /= 0) & write(6,'(/,a)') ' header of result and statistics file written out' flush(6) - else ! open new files ... - open(newunit=statUnit,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//& + else writeHeader + open(newunit=statUnit,file=trim(getSolverJobName())//& '.sta',form='FORMATTED', position='APPEND', status='OLD') - endif + endif writeHeader endif !-------------------------------------------------------------------------------------------------- @@ -415,40 +409,39 @@ program DAMASK_spectral outputSize(worldrank+1) = size(materialpoint_results,kind=MPI_OFFSET_KIND)*int(pReal,MPI_OFFSET_KIND) call MPI_allreduce(MPI_IN_PLACE,outputSize,worldsize,MPI_LONG,MPI_SUM,PETSC_COMM_WORLD,ierr) ! get total output size over each process if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_allreduce') - call MPI_file_open(PETSC_COMM_WORLD, & - trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.spectralOut', & + call MPI_file_open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.spectralOut', & MPI_MODE_WRONLY + MPI_MODE_APPEND, & MPI_INFO_NULL, & - resUnit, & + fileUnit, & ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_open') - call MPI_file_get_position(resUnit,fileOffset,ierr) ! get offset from header + call MPI_file_get_position(fileUnit,fileOffset,ierr) ! get offset from header if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_get_position') fileOffset = fileOffset + sum(outputSize(1:worldrank)) ! offset of my process in file (header + processes before me) - call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) + call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_seek') - if (.not. appendToOutFile) then ! if not restarting, write 0th increment + writeUndeformed: if (interface_restartInc < 1_pInt) then write(6,'(1/,a)') ' ... writing initial configuration to file ........................' do i = 1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex = int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & ! QUESTION: why not starting i at 0 instead of murky 1? min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) - call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & + call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)), & MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') enddo fileOffset = fileOffset + sum(outputSize) ! forward to current file position - endif + endif writeUndeformed !-------------------------------------------------------------------------------------------------- -! looping over loadcases +! looping over load cases loadCaseLooping: do currentLoadCase = 1_pInt, size(loadCases) - time0 = time ! currentLoadCase start time + time0 = time ! load case start time guess = loadCases(currentLoadCase)%followFormerTrajectory ! change of load case? homogeneous guess for the first inc !-------------------------------------------------------------------------------------------------- -! loop over incs defined in input file for current currentLoadCase +! loop over incs defined in input file for current load case incLooping: do inc = 1_pInt, loadCases(currentLoadCase)%incs totalIncsCounter = totalIncsCounter + 1_pInt @@ -458,13 +451,13 @@ program DAMASK_spectral if (loadCases(currentLoadCase)%logscale == 0_pInt) then ! linear scale timeinc = loadCases(currentLoadCase)%time/real(loadCases(currentLoadCase)%incs,pReal) else - if (currentLoadCase == 1_pInt) then ! 1st currentLoadCase of logarithmic scale - if (inc == 1_pInt) then ! 1st inc of 1st currentLoadCase of logarithmic scale + if (currentLoadCase == 1_pInt) then ! 1st load case of logarithmic scale + if (inc == 1_pInt) then ! 1st inc of 1st load case of logarithmic scale timeinc = loadCases(1)%time*(2.0_pReal**real( 1_pInt-loadCases(1)%incs ,pReal)) ! assume 1st inc is equal to 2nd - else ! not-1st inc of 1st currentLoadCase of logarithmic scale + else ! not-1st inc of 1st load case of logarithmic scale timeinc = loadCases(1)%time*(2.0_pReal**real(inc-1_pInt-loadCases(1)%incs ,pReal)) endif - else ! not-1st currentLoadCase of logarithmic scale + else ! not-1st load case of logarithmic scale timeinc = time0 * & ( (1.0_pReal + loadCases(currentLoadCase)%time/time0 )**(real( inc ,pReal)/& real(loadCases(currentLoadCase)%incs ,pReal))& @@ -512,24 +505,14 @@ program DAMASK_spectral do field = 1, nActiveFields select case(loadCases(currentLoadCase)%ID(field)) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - call Basic_forward (& + call mech_forward (& guess,timeinc,timeIncOld,remainingLoadCaseTime, & deformation_BC = loadCases(currentLoadCase)%deformation, & stress_BC = loadCases(currentLoadCase)%stress, & rotation_BC = loadCases(currentLoadCase)%rotation) - case (DAMASK_spectral_SolverPolarisation_label) - call Polarisation_forward (& - guess,timeinc,timeIncOld,remainingLoadCaseTime, & - deformation_BC = loadCases(currentLoadCase)%deformation, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - end select - - case(FIELD_THERMAL_ID); call spectral_thermal_forward() - case(FIELD_DAMAGE_ID); call spectral_damage_forward() + case(FIELD_THERMAL_ID); call spectral_thermal_forward() + case(FIELD_DAMAGE_ID); call spectral_damage_forward() end select enddo @@ -541,20 +524,10 @@ program DAMASK_spectral do field = 1, nActiveFields select case(loadCases(currentLoadCase)%ID(field)) case(FIELD_MECH_ID) - select case (spectral_solver) - case (DAMASK_spectral_SolverBasic_label) - solres(field) = Basic_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - case (DAMASK_spectral_SolverPolarisation_label) - solres(field) = Polarisation_solution (& - incInfo,timeinc,timeIncOld, & - stress_BC = loadCases(currentLoadCase)%stress, & - rotation_BC = loadCases(currentLoadCase)%rotation) - - end select + solres(field) = mech_solution (& + incInfo,timeinc,timeIncOld, & + stress_BC = loadCases(currentLoadCase)%stress, & + rotation_BC = loadCases(currentLoadCase)%rotation) case(FIELD_THERMAL_ID) solres(field) = spectral_thermal_solution(timeinc,timeIncOld,remainingLoadCaseTime) @@ -595,7 +568,7 @@ program DAMASK_spectral write(6,'(/,a)') ' cutting back ' else ! no more options to continue call IO_warning(850_pInt) - call MPI_file_close(resUnit,ierr) + call MPI_file_close(fileUnit,ierr) close(statUnit) call quit(-1_pInt*(lastRestartWritten+1_pInt)) ! quit and provide information about last restart inc written endif @@ -618,12 +591,12 @@ program DAMASK_spectral write(6,'(1/,a)') ' ... writing results to file ......................................' flush(6) call materialpoint_postResults() - call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) + call MPI_file_seek (fileUnit,fileOffset,MPI_SEEK_SET,ierr) if (ierr /= 0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') do i=1, size(materialpoint_results,3)/(maxByteOut/(materialpoint_sizeResults*pReal))+1 ! slice the output of my process in chunks not exceeding the limit for one output outputIndex=int([(i-1_pInt)*((maxRealOut)/materialpoint_sizeResults)+1_pInt, & min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) - call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& + call MPI_file_write(fileUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & int((outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)),& MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) @@ -651,10 +624,9 @@ program DAMASK_spectral convergedCounter, ' out of ', & notConvergedCounter + convergedCounter, ' (', & real(convergedCounter, pReal)/& - real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, & - ' %) increments converged!' + real(notConvergedCounter + convergedCounter,pReal)*100.0_pReal, ' %) increments converged!' flush(6) - call MPI_file_close(resUnit,ierr) + call MPI_file_close(fileUnit,ierr) close(statUnit) if (notConvergedCounter > 0_pInt) call quit(3_pInt) ! error if some are not converged @@ -673,10 +645,13 @@ end program DAMASK_spectral !-------------------------------------------------------------------------------------------------- subroutine quit(stop_id) #include - use MPI +#ifdef _OPENMP + use MPI, only: & + MPI_finalize +#endif use prec, only: & pInt - + implicit none integer(pInt), intent(in) :: stop_id integer, dimension(8) :: dateAndTime ! type default integer diff --git a/src/FEM_mech.f90 b/src/FEM_mech.f90 new file mode 100644 index 000000000..d05e3a184 --- /dev/null +++ b/src/FEM_mech.f90 @@ -0,0 +1,734 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @brief FEM PETSc solver +!-------------------------------------------------------------------------------------------------- +module FEM_mech +#include + +use PETScdmda +use PETScsnes +use PETScDM +use PETScDMplex + use prec, only: & + pInt, & + pReal + use math, only: & + math_I3 + use FEM_utilities, only: & + tSolutionState, & + tFieldBC, & + tComponentBC + use numerics, only: & + worldrank, & + worldsize + use mesh, only: & + mesh_Nboundaries, & + mesh_boundaries + + implicit none + private + +!-------------------------------------------------------------------------------------------------- +! derived types + type tSolutionParams + type(tFieldBC) :: fieldBC + real(pReal) :: timeinc + real(pReal) :: timeincOld + end type tSolutionParams + + type(tSolutionParams), private :: params + +!-------------------------------------------------------------------------------------------------- +! PETSc data + SNES, private :: mech_snes + Vec, private :: solution, solution_rate, solution_local + PetscInt, private :: dimPlex, cellDof, nQuadrature, nBasis + PetscReal, allocatable, target,dimension(:), private :: qPoints, qWeights + MatNullSpace, private :: matnull + +!-------------------------------------------------------------------------------------------------- +! stress, stiffness and compliance average etc. + character(len=1024), private :: incInfo + real(pReal), private, dimension(3,3) :: & + P_av = 0.0_pReal + logical, private :: ForwardData + real(pReal), parameter, private :: eps = 1.0e-18_pReal + + public :: & + FEM_mech_init, & + FEM_mech_solution ,& + FEM_mech_forward, & + FEM_mech_destroy + + external :: & + MatZeroRowsColumnsLocalIS, & + PetscQuadratureCreate, & + PetscFECreateDefault, & + PetscFESetQuadrature, & + PetscFEGetDimension, & + PetscFEDestroy, & + PetscFEGetDualSpace, & + PetscQuadratureDestroy, & + PetscDSSetDiscretization, & + PetscDSGetTotalDimension, & + PetscDSGetDiscretization, & + PetscDualSpaceGetFunctional, & + DMGetLabelSize, & + DMSNESSetFunctionLocal, & + DMSNESSetJacobianLocal, & + SNESSetOptionsPrefix, & + SNESSetConvergenceTest, & + PetscObjectSetName + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields and fills them with data, potentially from restart info +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_init(fieldBC) + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) + use IO, only: & + IO_timeStamp, & + IO_error + use DAMASK_interface, only: & + getSolverJobName + use mesh, only: & + geomMesh + use numerics, only: & + worldrank, & + itmax, & + integrationOrder + use FEM_Zoo, only: & + FEM_Zoo_nQuadrature, & + FEM_Zoo_QuadraturePoints, & + FEM_Zoo_QuadratureWeights + + implicit none + type(tFieldBC), intent(in) :: fieldBC + DM :: mech_mesh + PetscFE :: mechFE + PetscQuadrature :: mechQuad, functional + PetscDS :: mechDS + PetscDualSpace :: mechDualSpace + DMLabel :: BCLabel + PetscInt, allocatable, target :: numComp(:), numDoF(:), bcField(:) + PetscInt, pointer :: pNumComp(:), pNumDof(:), pBcField(:), pBcPoint(:) + PetscInt :: numBC, bcSize + IS :: bcPoint + IS, allocatable, target :: bcComps(:), bcPoints(:) + IS, pointer :: pBcComps(:), pBcPoints(:) + PetscSection :: section + PetscInt :: field, faceSet, topologDim, nNodalPoints + PetscReal, pointer :: qPointsP(:), qWeightsP(:), & + nodalPointsP(:), nodalWeightsP(:) + PetscReal, allocatable, target :: nodalPoints(:), nodalWeights(:) + PetscScalar, pointer :: px_scal(:) + PetscScalar, allocatable, target :: x_scal(:) + PetscReal :: detJ + PetscReal, allocatable, target :: v0(:), cellJ(:), invcellJ(:), cellJMat(:,:) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscInt :: cellStart, cellEnd, cell, basis + character(len=7) :: prefix = 'mechFE_' + PetscErrorCode :: ierr + + write(6,'(/,a)') ' <<<+- FEM_mech init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + +!-------------------------------------------------------------------------------------------------- +! Setup FEM mech mesh + call DMClone(geomMesh,mech_mesh,ierr); CHKERRQ(ierr) + call DMGetDimension(mech_mesh,dimPlex,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! Setup FEM mech discretization + allocate(qPoints(dimPlex*FEM_Zoo_nQuadrature(dimPlex,integrationOrder))) + allocate(qWeights(FEM_Zoo_nQuadrature(dimPlex,integrationOrder))) + qPoints = FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p + qWeights = FEM_Zoo_QuadratureWeights(dimPlex,integrationOrder)%p + nQuadrature = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) + qPointsP => qPoints + qWeightsP => qWeights + call PetscQuadratureCreate(PETSC_COMM_SELF,mechQuad,ierr); CHKERRQ(ierr) + call PetscQuadratureSetData(mechQuad,dimPlex,nQuadrature,qPointsP,qWeightsP,ierr) + CHKERRQ(ierr) + call PetscFECreateDefault(mech_mesh,dimPlex,dimPlex,PETSC_TRUE,prefix, & + integrationOrder,mechFE,ierr); CHKERRQ(ierr) + call PetscFESetQuadrature(mechFE,mechQuad,ierr); CHKERRQ(ierr) + call PetscFEGetDimension(mechFE,nBasis,ierr); CHKERRQ(ierr) + call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) + call PetscDSAddDiscretization(mechDS,mechFE,ierr); CHKERRQ(ierr) + call PetscDSGetTotalDimension(mechDS,cellDof,ierr); CHKERRQ(ierr) + call PetscFEDestroy(mechFE,ierr); CHKERRQ(ierr) + call PetscQuadratureDestroy(mechQuad,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! Setup FEM mech boundary conditions + call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) + call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) + call DMGetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) + allocate(numComp(1), source=dimPlex); pNumComp => numComp + allocate(numDof(dimPlex+1), source = 0); pNumDof => numDof + do topologDim = 0, dimPlex + call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr) + CHKERRQ(ierr) + call PetscSectionGetDof(section,cellStart,numDof(topologDim+1),ierr) + CHKERRQ(ierr) + enddo + numBC = 0 + do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries + if (fieldBC%componentBC(field)%Mask(faceSet)) numBC = numBC + 1 + enddo; enddo + allocate(bcField(numBC), source=0); pBcField => bcField + allocate(bcComps(numBC)); pBcComps => bcComps + allocate(bcPoints(numBC)); pBcPoints => bcPoints + numBC = 0 + do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries + if (fieldBC%componentBC(field)%Mask(faceSet)) then + numBC = numBC + 1 + call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,bcComps(numBC),ierr) + CHKERRQ(ierr) + call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) + CHKERRQ(ierr) + if (bcSize > 0) then + call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr) + CHKERRQ(ierr) + call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,bcPoints(numBC),ierr) + CHKERRQ(ierr) + call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) + call ISDestroy(bcPoint,ierr); CHKERRQ(ierr) + else + call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,bcPoints(numBC),ierr) + CHKERRQ(ierr) + endif + endif + enddo; enddo + call DMPlexCreateSection(mech_mesh,dimPlex,1,pNumComp,pNumDof, & + numBC,pBcField,pBcComps,pBcPoints,PETSC_NULL_IS, & + section,ierr) + CHKERRQ(ierr) + call DMSetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) + do faceSet = 1, numBC + call ISDestroy(bcPoints(faceSet),ierr); CHKERRQ(ierr) + enddo + +!-------------------------------------------------------------------------------------------------- +! initialize solver specific parts of PETSc + call SNESCreate(PETSC_COMM_WORLD,mech_snes,ierr);CHKERRQ(ierr) + call SNESSetOptionsPrefix(mech_snes,'mech_',ierr);CHKERRQ(ierr) + call SNESSetDM(mech_snes,mech_mesh,ierr); CHKERRQ(ierr) !< set the mesh for non-linear solver + call DMCreateGlobalVector(mech_mesh,solution ,ierr); CHKERRQ(ierr) !< locally owned displacement Dofs + call DMCreateGlobalVector(mech_mesh,solution_rate ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step + call DMCreateLocalVector (mech_mesh,solution_local ,ierr); CHKERRQ(ierr) !< locally owned velocity Dofs to guess solution at next load step + call DMSNESSetFunctionLocal(mech_mesh,FEM_mech_formResidual,PETSC_NULL_VEC,ierr) !< function to evaluate residual forces + CHKERRQ(ierr) + call DMSNESSetJacobianLocal(mech_mesh,FEM_mech_formJacobian,PETSC_NULL_VEC,ierr) !< function to evaluate stiffness matrix + CHKERRQ(ierr) + call SNESSetMaxLinearSolveFailures(mech_snes, huge(1), ierr); CHKERRQ(ierr) !< ignore linear solve failures + call SNESSetConvergenceTest(mech_snes,FEM_mech_converged,PETSC_NULL_VEC,PETSC_NULL_FUNCTION,ierr) + CHKERRQ(ierr) + call SNESSetTolerances(mech_snes,1.0,0.0,0.0,itmax,itmax,ierr) + CHKERRQ(ierr) + call SNESSetFromOptions(mech_snes,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! init fields + call VecSet(solution ,0.0,ierr); CHKERRQ(ierr) + call VecSet(solution_rate ,0.0,ierr); CHKERRQ(ierr) + allocate(x_scal(cellDof)) + allocate(nodalPoints (dimPlex)) + allocate(nodalWeights(1)) + nodalPointsP => nodalPoints + nodalWeightsP => nodalWeights + allocate(v0(dimPlex)) + allocate(cellJ(dimPlex*dimPlex)) + allocate(invcellJ(dimPlex*dimPlex)) + allocate(cellJMat(dimPlex,dimPlex)) + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMGetDefaultSection(mech_mesh,section,ierr); CHKERRQ(ierr) + call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) + call PetscDSGetDiscretization(mechDS,0,mechFE,ierr) + CHKERRQ(ierr) + call PetscFEGetDualSpace(mechFE,mechDualSpace,ierr); CHKERRQ(ierr) + call DMPlexGetHeightStratum(mech_mesh,0,cellStart,cellEnd,ierr) + CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + x_scal = 0.0 + call DMPlexComputeCellGeometryAffineFEM(mech_mesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + cellJMat = reshape(pCellJ,shape=[dimPlex,dimPlex]) + do basis = 0, nBasis-1 + call PetscDualSpaceGetFunctional(mechDualSpace,basis,functional,ierr) + CHKERRQ(ierr) + call PetscQuadratureGetData(functional,dimPlex,nNodalPoints,nodalPointsP,nodalWeightsP,ierr) + CHKERRQ(ierr) + x_scal(basis*dimPlex+1:(basis+1)*dimPlex) = pV0 + matmul(transpose(cellJMat),nodalPointsP + 1.0) + enddo + px_scal => x_scal + call DMPlexVecSetClosure(mech_mesh,section,solution_local,cell,px_scal,INSERT_ALL_VALUES,ierr) + CHKERRQ(ierr) + enddo + +end subroutine FEM_mech_init + +!-------------------------------------------------------------------------------------------------- +!> @brief solution for the FEM load step +!-------------------------------------------------------------------------------------------------- +type(tSolutionState) function FEM_mech_solution( & + incInfoIn,timeinc,timeinc_old,fieldBC) + use numerics, only: & + itmax + use FEsolving, only: & + terminallyIll + + implicit none +!-------------------------------------------------------------------------------------------------- +! input data for solution + real(pReal), intent(in) :: & + timeinc, & !< increment in time for current solution + timeinc_old !< increment in time of last increment + type(tFieldBC), intent(in) :: & + fieldBC + character(len=*), intent(in) :: & + incInfoIn + +!-------------------------------------------------------------------------------------------------- +! + PetscErrorCode :: ierr + SNESConvergedReason :: reason + + incInfo = incInfoIn + FEM_mech_solution%converged =.false. +!-------------------------------------------------------------------------------------------------- +! set module wide availabe data + params%timeinc = timeinc + params%timeincOld = timeinc_old + params%fieldBC = fieldBC + + call SNESSolve(mech_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) ! solve mech_snes based on solution guess (result in solution) + call SNESGetConvergedReason(mech_snes,reason,ierr); CHKERRQ(ierr) ! solution converged? + terminallyIll = .false. + + if (reason < 1) then ! 0: still iterating (will not occur), negative -> convergence error + FEM_mech_solution%converged = .false. + FEM_mech_solution%iterationsNeeded = itmax + else ! >= 1 proper convergence (or terminally ill) + FEM_mech_solution%converged = .true. + call SNESGetIterationNumber(mech_snes,FEM_mech_solution%iterationsNeeded,ierr) + CHKERRQ(ierr) + endif + + write(6,'(/,a)') ' ===========================================================================' + flush(6) + +end function FEM_mech_solution + + +!-------------------------------------------------------------------------------------------------- +!> @brief forms the FEM residual vector +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr) + use numerics, only: & + BBarStabilisation + use FEM_utilities, only: & + utilities_projectBCValues, & + utilities_constitutiveResponse + use homogenization, only: & + materialpoint_F, & + materialpoint_P + use math, only: & + math_det33, & + math_inv33 + use FEsolving, only: & + terminallyIll + + implicit none + DM :: dm_local + PetscDS :: prob + Vec :: x_local, f_local, xx_local + PetscSection :: section + PetscScalar, dimension(:), pointer :: x_scal, pf_scal + PetscScalar, target :: f_scal(cellDof) + PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & + invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal, pointer :: basisField(:), basisFieldDer(:) + PetscInt :: cellStart, cellEnd, cell, field, face, & + qPt, basis, comp, cidx + PetscReal :: detFAvg + PetscReal :: BMat(dimPlex*dimPlex,cellDof) + PetscObject :: dummy + PetscInt :: bcSize + IS :: bcPoints + PetscErrorCode :: ierr + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) + call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) + call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) + CHKERRQ(ierr) + call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + call VecWAXPY(x_local,1.0,xx_local,solution_local,ierr); CHKERRQ(ierr) + do field = 1, dimPlex; do face = 1, mesh_Nboundaries + if (params%fieldBC%componentBC(field)%Mask(face)) then + call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr) + if (bcSize > 0) then + call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr) + CHKERRQ(ierr) + call utilities_projectBCValues(x_local,section,0,field-1,bcPoints, & + 0.0,params%fieldBC%componentBC(field)%Value(face),params%timeinc) + call ISDestroy(bcPoints,ierr); CHKERRQ(ierr) + endif + endif + enddo; enddo + +!-------------------------------------------------------------------------------------------------- +! evaluate field derivatives + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element + CHKERRQ(ierr) + call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) + do qPt = 0, nQuadrature-1 + BMat = 0.0 + do basis = 0, nBasis-1 + do comp = 0, dimPlex-1 + cidx = basis*dimPlex+comp + BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & + matmul(IcellJMat,basisFieldDer((qPt*nBasis*dimPlex+cidx )*dimPlex+1: & + (qPt*nBasis*dimPlex+cidx+1)*dimPlex )) + enddo + enddo + materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1) = & + reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex], order=[2,1]) + enddo + if (BBarStabilisation) then + detFAvg = math_det33(sum(materialpoint_F(1:3,1:3,1:nQuadrature,cell+1),dim=3)/real(nQuadrature)) + do qPt = 1, nQuadrature + materialpoint_F(1:dimPlex,1:dimPlex,qPt,cell+1) = & + materialpoint_F(1:dimPlex,1:dimPlex,qPt,cell+1)* & + (detFAvg/math_det33(materialpoint_F(1:3,1:3,qPt,cell+1)))**(1.0/real(dimPlex)) + + enddo + endif + call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + +!-------------------------------------------------------------------------------------------------- +! evaluate constitutive response + call Utilities_constitutiveResponse(params%timeinc,P_av,ForwardData) + call MPI_Allreduce(MPI_IN_PLACE,terminallyIll,1,MPI_LOGICAL,MPI_LOR,PETSC_COMM_WORLD,ierr) + ForwardData = .false. + +!-------------------------------------------------------------------------------------------------- +! integrating residual + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element + CHKERRQ(ierr) + call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + IcellJMat = reshape(pInvcellJ,shape=[dimPlex,dimPlex]) + f_scal = 0.0 + do qPt = 0, nQuadrature-1 + BMat = 0.0 + do basis = 0, nBasis-1 + do comp = 0, dimPlex-1 + cidx = basis*dimPlex+comp + BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & + matmul(IcellJMat,basisFieldDer((qPt*nBasis*dimPlex+cidx )*dimPlex+1: & + (qPt*nBasis*dimPlex+cidx+1)*dimPlex )) + enddo + enddo + f_scal = f_scal + & + matmul(transpose(BMat), & + reshape(transpose(materialpoint_P(1:dimPlex,1:dimPlex,qPt+1,cell+1)), & + shape=[dimPlex*dimPlex]))*qWeights(qPt+1) + enddo + f_scal = f_scal*abs(detJ) + pf_scal => f_scal + call DMPlexVecSetClosure(dm_local,section,f_local,cell,pf_scal,ADD_VALUES,ierr) + CHKERRQ(ierr) + call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_formResidual + + +!-------------------------------------------------------------------------------------------------- +!> @brief forms the FEM stiffness matrix +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr) + use numerics, only: & + BBarStabilisation + use homogenization, only: & + materialpoint_dPdF, & + materialpoint_F + use math, only: & + math_inv33, & + math_identity2nd, & + math_det33 + use FEM_utilities, only: & + utilities_projectBCValues + + implicit none + + DM :: dm_local + PetscDS :: prob + Vec :: x_local, xx_local + Mat :: Jac_pre, Jac + PetscSection :: section, gSection + PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & + invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal, dimension(:), pointer :: basisField, basisFieldDer + PetscInt :: cellStart, cellEnd, cell, field, face, & + qPt, basis, comp, cidx + PetscScalar, target :: K_e (cellDof,cellDof), & + K_eA (cellDof,cellDof), & + K_eB (cellDof,cellDof), & + K_eVec(cellDof*cellDof) + PetscReal :: BMat (dimPlex*dimPlex,cellDof), & + BMatAvg(dimPlex*dimPlex,cellDof), & + MatA (dimPlex*dimPlex,cellDof), & + MatB (1 ,cellDof) + PetscScalar, dimension(:), pointer :: pK_e, x_scal + PetscReal, dimension(3,3) :: F = math_I3, FAvg, FInv + PetscObject :: dummy + PetscInt :: bcSize + IS :: bcPoints + PetscErrorCode :: ierr + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call MatSetOption(Jac,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE,ierr); CHKERRQ(ierr) + call MatSetOption(Jac,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE,ierr); CHKERRQ(ierr) + call MatZeroEntries(Jac,ierr); CHKERRQ(ierr) + call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) + call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) + call DMGetDefaultGlobalSection(dm_local,gSection,ierr); CHKERRQ(ierr) + + call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + call VecWAXPY(x_local,1.0,xx_local,solution_local,ierr); CHKERRQ(ierr) + do field = 1, dimPlex; do face = 1, mesh_Nboundaries + if (params%fieldBC%componentBC(field)%Mask(face)) then + call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr) + if (bcSize > 0) then + call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr) + CHKERRQ(ierr) + call utilities_projectBCValues(x_local,section,0,field-1,bcPoints, & + 0.0,params%fieldBC%componentBC(field)%Value(face),params%timeinc) + call ISDestroy(bcPoints,ierr); CHKERRQ(ierr) + endif + endif + enddo; enddo + call DMPlexGetHeightStratum(dm_local,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexVecGetClosure(dm_local,section,x_local,cell,x_scal,ierr) !< get Dofs belonging to element + CHKERRQ(ierr) + call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + IcellJMat = reshape(pInvcellJ, shape = [dimPlex,dimPlex]) + K_eA = 0.0 + K_eB = 0.0 + MatB = 0.0 + FAvg = 0.0 + BMatAvg = 0.0 + do qPt = 0, nQuadrature-1 + BMat = 0.0 + do basis = 0, nBasis-1 + do comp = 0, dimPlex-1 + cidx = basis*dimPlex+comp + BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & + matmul(IcellJMat,basisFieldDer((qPt*nBasis*dimPlex+cidx )*dimPlex+1: & + (qPt*nBasis*dimPlex+cidx+1)*dimPlex )) + enddo + enddo + MatA = matmul(reshape(reshape(materialpoint_dPdF(1:dimPlex,1:dimPlex,1:dimPlex,1:dimPlex,qPt+1,cell+1), & + shape=[dimPlex,dimPlex,dimPlex,dimPlex], order=[2,1,4,3]), & + shape=[dimPlex*dimPlex,dimPlex*dimPlex]),BMat)*qWeights(qPt+1) + if (BBarStabilisation) then + F(1:dimPlex,1:dimPlex) = reshape(matmul(BMat,x_scal),shape=[dimPlex,dimPlex]) + FInv = math_inv33(F) + K_eA = K_eA + matmul(transpose(BMat),MatA)*math_det33(FInv)**(1.0/real(dimPlex)) + K_eB = K_eB - & + matmul(transpose(matmul(reshape(materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1), & + shape=[dimPlex*dimPlex,1]), & + matmul(reshape(FInv(1:dimPlex,1:dimPlex), & + shape=[1,dimPlex*dimPlex],order=[2,1]),BMat))),MatA) + MatB = MatB + & + matmul(reshape(materialpoint_F(1:dimPlex,1:dimPlex,qPt+1,cell+1),shape=[1,dimPlex*dimPlex]),MatA) + FAvg = FAvg + F + BMatAvg = BMatAvg + BMat + else + K_eA = K_eA + matmul(transpose(BMat),MatA) + endif + enddo + if (BBarStabilisation) then + FInv = math_inv33(FAvg) + K_e = K_eA*math_det33(FAvg/real(nQuadrature))**(1.0/real(dimPlex)) + & + (matmul(matmul(transpose(BMatAvg), & + reshape(FInv(1:dimPlex,1:dimPlex),shape=[dimPlex*dimPlex,1],order=[2,1])),MatB) + & + K_eB)/real(dimPlex) + + else + K_e = K_eA + endif + K_e = K_e + eps*math_identity2nd(cellDof) + K_eVec = reshape(K_e, [cellDof*cellDof])*abs(detJ) + pK_e => K_eVec + call DMPlexMatSetClosure(dm_local,section,gSection,Jac,cell,pK_e,ADD_VALUES,ierr) + CHKERRQ(ierr) + call DMPlexVecRestoreClosure(dm_local,section,x_local,cell,x_scal,ierr) + CHKERRQ(ierr) + enddo + call MatAssemblyBegin(Jac,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call MatAssemblyEnd(Jac,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call MatAssemblyBegin(Jac_pre,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call MatAssemblyEnd(Jac_pre,MAT_FINAL_ASSEMBLY,ierr); CHKERRQ(ierr) + call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! apply boundary conditions + !call DMPlexCreateRigidBody(dm_local,matnull,ierr); CHKERRQ(ierr) MD: linker error + call MatSetNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) + call MatSetNearNullSpace(Jac,matnull,ierr); CHKERRQ(ierr) + call MatNullSpaceDestroy(matnull,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_formJacobian + +!-------------------------------------------------------------------------------------------------- +!> @brief forwarding routine +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_forward(guess,timeinc,timeinc_old,fieldBC) + use FEM_utilities, only: & + cutBack + use homogenization, only: & + materialpoint_F0, & + materialpoint_F + use FEM_utilities, only: & + utilities_projectBCValues + + implicit none + type(tFieldBC), intent(in) :: & + fieldBC + real(pReal), intent(in) :: & + timeinc_old, & + timeinc + logical, intent(in) :: & + guess + PetscInt :: field, face + DM :: dm_local + Vec :: x_local + PetscSection :: section + PetscInt :: bcSize + IS :: bcPoints + PetscErrorCode :: ierr + +!-------------------------------------------------------------------------------------------------- +! forward last inc + if (guess .and. .not. cutBack) then + ForwardData = .True. + materialpoint_F0 = materialpoint_F + call SNESGetDM(mech_snes,dm_local,ierr); CHKERRQ(ierr) !< retrieve mesh info from mech_snes into dm_local + call DMGetDefaultSection(dm_local,section,ierr); CHKERRQ(ierr) + call DMGetLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + call VecSet(x_local,0.0,ierr); CHKERRQ(ierr) + call DMGlobalToLocalBegin(dm_local,solution,INSERT_VALUES,x_local,ierr) !< retrieve my partition of global solution vector + CHKERRQ(ierr) + call DMGlobalToLocalEnd(dm_local,solution,INSERT_VALUES,x_local,ierr) + CHKERRQ(ierr) + call VecAXPY(solution_local,1.0,x_local,ierr); CHKERRQ(ierr) + do field = 1, dimPlex; do face = 1, mesh_Nboundaries + if (fieldBC%componentBC(field)%Mask(face)) then + call DMGetStratumSize(dm_local,'Face Sets',mesh_boundaries(face),bcSize,ierr) + if (bcSize > 0) then + call DMGetStratumIS(dm_local,'Face Sets',mesh_boundaries(face),bcPoints,ierr) + CHKERRQ(ierr) + call utilities_projectBCValues(solution_local,section,0,field-1,bcPoints, & + 0.0,fieldBC%componentBC(field)%Value(face),timeinc_old) + call ISDestroy(bcPoints,ierr); CHKERRQ(ierr) + endif + endif + enddo; enddo + call DMRestoreLocalVector(dm_local,x_local,ierr); CHKERRQ(ierr) + +!-------------------------------------------------------------------------------------------------- +! update rate and forward last inc + call VecCopy(solution,solution_rate,ierr); CHKERRQ(ierr) + call VecScale(solution_rate,1.0/timeinc_old,ierr); CHKERRQ(ierr) + endif + call VecCopy(solution_rate,solution,ierr); CHKERRQ(ierr) + call VecScale(solution,timeinc,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_forward + + +!-------------------------------------------------------------------------------------------------- +!> @brief reporting +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_converged(snes_local,PETScIter,xnorm,snorm,fnorm,reason,dummy,ierr) + use numerics, only: & + err_struct_tolAbs, & + err_struct_tolRel + use IO, only: & + IO_intOut + use FEsolving, only: & + terminallyIll + + implicit none + SNES :: snes_local + PetscInt :: PETScIter + PetscReal :: xnorm,snorm,fnorm,divTol + SNESConvergedReason :: reason + PetscObject :: dummy + PetscErrorCode :: ierr + +!-------------------------------------------------------------------------------------------------- +! report + divTol = max(maxval(abs(P_av(1:dimPlex,1:dimPlex)))*err_struct_tolRel,err_struct_tolAbs) + call SNESConvergedDefault(snes_local,PETScIter,xnorm,snorm,fnorm/divTol,reason,dummy,ierr) + CHKERRQ(ierr) + if (terminallyIll) reason = SNES_DIVERGED_FUNCTION_DOMAIN + if (worldrank == 0) then + write(6,'(1/,1x,a,a,i0,a,i0,f0.3)') trim(incInfo), & + ' @ Iteration ',PETScIter,' mechanical residual norm = ', & + int(fnorm/divTol),fnorm/divTol-int(fnorm/divTol) + write(6,'(/,a,/,3(3(2x,f12.4,1x)/))',advance='no') ' Piola--Kirchhoff stress / MPa =',& + transpose(P_av)*1.e-6_pReal + flush(6) + endif + +end subroutine FEM_mech_converged + + +!-------------------------------------------------------------------------------------------------- +!> @brief destroy routine +!-------------------------------------------------------------------------------------------------- +subroutine FEM_mech_destroy() + + implicit none + PetscErrorCode :: ierr + + call VecDestroy(solution,ierr); CHKERRQ(ierr) + call VecDestroy(solution_rate,ierr); CHKERRQ(ierr) + call SNESDestroy(mech_snes,ierr); CHKERRQ(ierr) + +end subroutine FEM_mech_destroy + +end module FEM_mech diff --git a/src/FEM_utilities.f90 b/src/FEM_utilities.f90 new file mode 100644 index 000000000..f911835ac --- /dev/null +++ b/src/FEM_utilities.f90 @@ -0,0 +1,751 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Utilities used by the FEM solver +!-------------------------------------------------------------------------------------------------- +module FEM_utilities +#include + use prec, only: pReal, pInt + +use PETScdmda +use PETScis + + implicit none + private +!-------------------------------------------------------------------------------------------------- +! + logical, public :: cutBack = .false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill + integer(pInt), public, parameter :: maxFields = 6_pInt + integer(pInt), public :: nActiveFields = 0_pInt + +!-------------------------------------------------------------------------------------------------- +! grid related information information + real(pReal), public :: wgt !< weighting factor 1/Nelems + real(pReal), public :: wgtDof !< weighting factor 1/Nelems + real(pReal), public :: C_volAvg(3,3,3,3) + +!-------------------------------------------------------------------------------------------------- +! output data + PetscViewer, public :: resUnit + Vec, public :: coordinatesVec + Vec, allocatable, public :: homogenizationResultsVec(:), & + crystalliteResultsVec(:,:), & + phaseResultsVec(:,:) + +!-------------------------------------------------------------------------------------------------- +! field labels information + character(len=*), parameter, public :: & + FIELD_MECH_label = 'mechanical', & + FIELD_THERMAL_label = 'thermal', & + FIELD_DAMAGE_label = 'damage', & + FIELD_SOLUTE_label = 'solute', & + FIELD_MGTWIN_label = 'mgtwin' + + enum, bind(c) + enumerator :: FIELD_UNDEFINED_ID, & + FIELD_MECH_ID, & + FIELD_THERMAL_ID, & + FIELD_DAMAGE_ID, & + FIELD_SOLUTE_ID, & + FIELD_MGTWIN_ID + end enum + enum, bind(c) + enumerator :: COMPONENT_UNDEFINED_ID, & + COMPONENT_MECH_X_ID, & + COMPONENT_MECH_Y_ID, & + COMPONENT_MECH_Z_ID, & + COMPONENT_THERMAL_T_ID, & + COMPONENT_DAMAGE_PHI_ID, & + COMPONENT_SOLUTE_CV_ID, & + COMPONENT_SOLUTE_CVPOT_ID, & + COMPONENT_SOLUTE_CH_ID, & + COMPONENT_SOLUTE_CHPOT_ID, & + COMPONENT_SOLUTE_CVaH_ID, & + COMPONENT_SOLUTE_CVaHPOT_ID, & + COMPONENT_MGTWIN_PHI_ID + end enum + +!-------------------------------------------------------------------------------------------------- +! variables controlling debugging + logical, private :: & + debugGeneral, & !< general debugging of FEM solver + debugRotation, & !< also printing out results in lab frame + debugPETSc !< use some in debug defined options for more verbose PETSc solution + +!-------------------------------------------------------------------------------------------------- +! derived types + type, public :: tSolutionState !< return type of solution from FEM solver variants + logical :: converged = .true. + logical :: stagConverged = .true. + logical :: regrid = .false. + integer(pInt) :: iterationsNeeded = 0_pInt + end type tSolutionState + + type, public :: tComponentBC + integer(kind(COMPONENT_UNDEFINED_ID)) :: ID + real(pReal), allocatable :: Value(:) + logical, allocatable :: Mask(:) + end type tComponentBC + + type, public :: tFieldBC + integer(kind(FIELD_UNDEFINED_ID)) :: ID + integer(pInt) :: nComponents = 0_pInt + type(tComponentBC), allocatable :: componentBC(:) + end type tFieldBC + + type, public :: tLoadCase + real(pReal) :: time = 0.0_pReal !< length of increment + integer(pInt) :: incs = 0_pInt, & !< number of increments + outputfrequency = 1_pInt, & !< frequency of result writes + restartfrequency = 0_pInt, & !< frequency of restart writes + logscale = 0_pInt !< linear/logarithmic time inc flag + logical :: followFormerTrajectory = .true. !< follow trajectory of former loadcase + integer(pInt), allocatable :: faceID(:) + type(tFieldBC), allocatable :: fieldBC(:) + end type tLoadCase + + type, public :: tFEMInterpolation + integer(pInt) :: n + real(pReal), dimension(:,:) , allocatable :: shapeFunc, shapeDerivReal, geomShapeDerivIso + real(pReal), dimension(:,:,:), allocatable :: shapeDerivIso + end type tFEMInterpolation + + type, public :: tQuadrature + integer(pInt) :: n + real(pReal), dimension(:) , allocatable :: Weights + real(pReal), dimension(:,:), allocatable :: Points + end type tQuadrature + + public :: & + utilities_init, & + utilities_constitutiveResponse, & + utilities_indexBoundaryDofs, & + utilities_projectBCValues, & + utilities_indexActiveSet, & + utilities_destroy, & + FIELD_MECH_ID, & + FIELD_THERMAL_ID, & + FIELD_DAMAGE_ID, & + FIELD_SOLUTE_ID, & + FIELD_MGTWIN_ID, & + COMPONENT_MECH_X_ID, & + COMPONENT_MECH_Y_ID, & + COMPONENT_MECH_Z_ID, & + COMPONENT_THERMAL_T_ID, & + COMPONENT_DAMAGE_PHI_ID, & + COMPONENT_SOLUTE_CV_ID, & + COMPONENT_SOLUTE_CVPOT_ID, & + COMPONENT_SOLUTE_CH_ID, & + COMPONENT_SOLUTE_CHPOT_ID, & + COMPONENT_SOLUTE_CVaH_ID, & + COMPONENT_SOLUTE_CVaHPOT_ID, & + COMPONENT_MGTWIN_PHI_ID + + external :: & + PetscOptionsInsertString, & + PetscObjectSetName, & + DMPlexGetHeightStratum, & + DMGetLabelIdIS, & + DMPlexGetChart, & + DMPlexLabelComplete, & + PetscViewerHDF5Open, & + PetscViewerHDF5PushGroup, & + PetscViewerHDF5PopGroup, & + PetscViewerDestroy + +contains + +!-------------------------------------------------------------------------------------------------- +!> @brief allocates all neccessary fields, sets debug flags +!-------------------------------------------------------------------------------------------------- +subroutine utilities_init() + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran >4.6 at the moment) + use DAMASK_interface, only: & + getSolverJobName + use IO, only: & + IO_error, & + IO_warning, & + IO_timeStamp, & + IO_open_file + use numerics, only: & + integrationOrder, & + worldsize, & + worldrank, & + petsc_defaultOptions, & + petsc_options + use debug, only: & + debug_level, & + debug_SPECTRAL, & + debug_LEVELBASIC, & + debug_SPECTRALPETSC, & + debug_SPECTRALROTATION + use debug, only: & + PETSCDEBUG + use math ! must use the whole module for use of FFTW + use mesh, only: & + mesh_NcpElemsGlobal, & + mesh_maxNips, & + geomMesh + use material, only: & + material_homog + + implicit none + + character(len=1024) :: petsc_optionsPhysics, grainStr + integer(pInt) :: dimPlex + integer(pInt) :: headerID = 205_pInt + PetscInt, dimension(:), pointer :: points + PetscInt, allocatable :: nEntities(:), nOutputCells(:), nOutputNodes(:), mappingCells(:) + PetscInt :: cellStart, cellEnd, cell, ip, dim, ctr, qPt + PetscInt, allocatable :: connectivity(:,:) + Vec :: connectivityVec + PetscErrorCode :: ierr + + write(6,'(/,a)') ' <<<+- DAMASK_FEM_utilities init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + +!-------------------------------------------------------------------------------------------------- +! set debugging parameters + debugGeneral = iand(debug_level(debug_SPECTRAL),debug_LEVELBASIC) /= 0 + debugRotation = iand(debug_level(debug_SPECTRAL),debug_SPECTRALROTATION) /= 0 + debugPETSc = iand(debug_level(debug_SPECTRAL),debug_SPECTRALPETSC) /= 0 + if(debugPETSc) write(6,'(3(/,a),/)') & + ' Initializing PETSc with debug options: ', & + trim(PETScDebug), & + ' add more using the PETSc_Options keyword in numerics.config ' + flush(6) + call PetscOptionsClear(PETSC_NULL_OPTIONS,ierr) + CHKERRQ(ierr) + if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr) + CHKERRQ(ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr) + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr) + CHKERRQ(ierr) + !write(petsc_optionsPhysics,'(a,i0)') '-mechFE_petscspace_order ' , structOrder + call PetscOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_optionsPhysics),ierr) + CHKERRQ(ierr) + + wgt = 1.0/real(mesh_maxNips*mesh_NcpElemsGlobal,pReal) + + call PetscViewerHDF5Open(PETSC_COMM_WORLD, trim(getSolverJobName())//'.h5', & + FILE_MODE_WRITE, resUnit, ierr); CHKERRQ(ierr) + call PetscViewerHDF5PushGroup(resUnit, '/', ierr); CHKERRQ(ierr) + call DMGetDimension(geomMesh,dimPlex,ierr); CHKERRQ(ierr) + allocate(nEntities(dimPlex+1), source=0) + allocate(nOutputNodes(worldsize), source = 0) + allocate(nOutputCells(worldsize), source = 0) + do dim = 0, dimPlex + call DMGetStratumSize(geomMesh,'depth',dim,nEntities(dim+1),ierr) + CHKERRQ(ierr) + enddo + select case (integrationOrder) + case(1_pInt) + nOutputNodes(worldrank+1) = nEntities(1) + case(2_pInt) + nOutputNodes(worldrank+1) = sum(nEntities) + case default + nOutputNodes(worldrank+1) = mesh_maxNips*nEntities(dimPlex+1) + end select + 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 + + allocate(connectivity(2**dimPlex,nOutputCells(worldrank+1))) + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr) + CHKERRQ(ierr) + ctr = 0 + select case (integrationOrder) + case(1_pInt) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexGetTransitiveClosure(geomMesh,cell,PETSC_TRUE,points,ierr) + CHKERRQ(ierr) + if (dimPlex == 2) then + connectivity(:,ctr+1) = [points( 9), points(11), points(13), points(13)] - nEntities(dimPlex+1) + ctr = ctr + 1 + else + connectivity(:,ctr+1) = [points(23), points(25), points(27), points(27), & + points(29), points(29), points(29), points(29)] - nEntities(dimPlex+1) + ctr = ctr + 1 + endif + enddo + + case(2_pInt) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexGetTransitiveClosure(geomMesh,cell,PETSC_TRUE,points,ierr) + CHKERRQ(ierr) + if (dimPlex == 2) then + connectivity(:,ctr+1) = [points(9 ), points(3), points(1), points(7)] + connectivity(:,ctr+2) = [points(11), points(5), points(1), points(3)] + connectivity(:,ctr+3) = [points(13), points(7), points(1), points(5)] + ctr = ctr + 3 + else + connectivity(:,ctr+1) = [points(23), points(11), points(3), points(15), points(17), points(5), points(1), points(7)] + connectivity(:,ctr+2) = [points(25), points(13), points(3), points(11), points(19), points(9), points(1), points(5)] + connectivity(:,ctr+3) = [points(27), points(15), points(3), points(13), points(21), points(7), points(1), points(9)] + connectivity(:,ctr+4) = [points(29), points(17), points(7), points(21), points(19), points(5), points(1), points(9)] + ctr = ctr + 4_pInt + endif + enddo + + case default + do cell = cellStart, cellEnd-1; do ip = 0, mesh_maxNips-1 + connectivity(:,ctr+1) = cell*mesh_maxNips + ip + ctr = ctr + 1 + enddo; enddo + + end select + connectivity = connectivity + sum(nOutputNodes(1:worldrank)) + + call VecCreateMPI(PETSC_COMM_WORLD,dimPlex*nOutputNodes(worldrank+1),dimPlex*sum(nOutputNodes), & + coordinatesVec,ierr);CHKERRQ(ierr) + call PetscObjectSetName(coordinatesVec, 'NodalCoordinates',ierr) + call VecSetFromOptions(coordinatesVec, ierr); CHKERRQ(ierr) + + !allocate(mappingCells(worldsize), source = 0) + !do homog = 1, material_Nhomogenization + ! mappingCells = 0_pInt; mappingCells(worldrank+1) = homogOutput(homog)%sizeIpCells + ! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + ! homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) + ! if (sum(mappingCells) > 0) then + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + ! connectivityVec,ierr);CHKERRQ(ierr) + ! call PetscObjectSetName(connectivityVec,'mapping_'//trim(homogenization_name(homog)),ierr) + ! CHKERRQ(ierr) + ! call VecGetArrayF90(connectivityVec,results,ierr); CHKERRQ(ierr) + ! results = 0.0_pReal; ctr = 1_pInt + ! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + ! if (material_homog(qPt,cell+1) == homog) then + ! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + ! shape=[2**dimPlex])) + ! ctr = ctr + 2**dimPlex + ! endif + ! enddo; enddo + ! call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + ! call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) + ! call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) + ! call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) + ! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + ! endif + !enddo + !do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + ! mappingCells = 0_pInt + ! mappingCells(worldrank+1) = crystalliteOutput(cryst,grain)%sizeIpCells + ! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + ! crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) + ! if (sum(mappingCells) > 0) then + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + ! connectivityVec,ierr);CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! call PetscObjectSetName(connectivityVec,'mapping_'// & + ! trim(crystallite_name(cryst))//'_'// & + ! trim(grainStr),ierr) + ! CHKERRQ(ierr) + ! call VecGetArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + ! results = 0.0_pReal; ctr = 1_pInt + ! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + ! if (homogenization_Ngrains (mesh_element(3,cell+1)) >= grain .and. & + ! microstructure_crystallite(mesh_element(4,cell+1)) == cryst) then + ! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + ! shape=[2**dimPlex])) + ! ctr = ctr + 2**dimPlex + ! endif + ! enddo; enddo + ! call VecRestoreArrayF90(connectivityVec, results, ierr); CHKERRQ(ierr) + ! call VecAssemblyBegin(connectivityVec, ierr); CHKERRQ(ierr) + ! call VecAssemblyEnd (connectivityVec, ierr); CHKERRQ(ierr) + ! call VecView(connectivityVec, resUnit, ierr); CHKERRQ(ierr) + ! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + ! endif + !enddo; enddo + !do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + ! mappingCells = 0_pInt + ! mappingCells(worldrank+1) = phaseOutput(phase,grain)%sizeIpCells + ! call MPI_Allreduce(MPI_IN_PLACE,mappingCells,worldsize,MPI_INT,MPI_SUM,PETSC_COMM_WORLD,ierr) + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1),sum(mappingCells), & + ! phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) + ! if (sum(mappingCells) > 0) then + ! call VecCreateMPI(PETSC_COMM_WORLD,mappingCells(worldrank+1)*2**dimPlex,sum(mappingCells)*2**dimPlex, & + ! connectivityVec,ierr);CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! call PetscObjectSetName(connectivityVec,& + ! 'mapping_'//trim(phase_name(phase))//'_'// & + ! trim(grainStr),ierr) + ! CHKERRQ(ierr) + ! call VecGetArrayF90(connectivityVec, results, ierr) + ! CHKERRQ(ierr) + ! results = 0.0_pReal; ctr = 1_pInt + ! do cell = cellStart, cellEnd-1; do qPt = 1, mesh_maxNips + ! if (material_phase(grain,qPt,cell+1) == phase) then + ! results(ctr:ctr+2**dimPlex-1) = real(reshape(connectivity(1:2**dimPlex,mesh_maxNips*cell+qPt), & + ! shape=[2**dimPlex])) + ! ctr = ctr + 2**dimPlex + ! endif + ! enddo; enddo + ! call VecRestoreArrayF90(connectivityVec, results, ierr) + ! CHKERRQ(ierr) + ! call VecAssemblyBegin(connectivityVec, ierr);CHKERRQ(ierr) + ! call VecAssemblyEnd (connectivityVec, ierr);CHKERRQ(ierr) + ! call VecView(connectivityVec, resUnit, ierr);CHKERRQ(ierr) + ! call VecDestroy(connectivityVec, ierr); CHKERRQ(ierr) + ! endif + !enddo; enddo + !if (worldrank == 0_pInt) then + ! do homog = 1, material_Nhomogenization + ! call VecGetSize(homogenizationResultsVec(homog),mappingCells(1),ierr) + ! CHKERRQ(ierr) + ! if (mappingCells(1) > 0) & + ! write(headerID, '(a,i0)') 'number of homog_'// & + ! trim(homogenization_name(homog))//'_'// & + ! 'cells : ', mappingCells(1) + ! enddo + ! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_maxNgrains + ! call VecGetSize(crystalliteResultsVec(cryst,grain),mappingCells(1),ierr) + ! CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! if (mappingCells(1) > 0) & + ! write(headerID, '(a,i0)') 'number of cryst_'// & + ! trim(crystallite_name(cryst))//'_'// & + ! trim(grainStr)//'_'// & + ! 'cells : ', mappingCells(1) + ! enddo; enddo + ! do phase = 1, material_Nphase; do grain = 1, homogenization_maxNgrains + ! call VecGetSize(phaseResultsVec(phase,grain),mappingCells(1),ierr) + ! CHKERRQ(ierr) + ! write(grainStr,'(a,i0)') 'Grain',grain + ! if (mappingCells(1) > 0) & + ! write(headerID, '(a,i0)') 'number of phase_'// & + ! trim(phase_name(phase))//'_'//trim(grainStr)//'_'// & + ! 'cells : ', mappingCells(1) + ! enddo; enddo + ! close(headerID) + !endif + +end subroutine utilities_init + +!-------------------------------------------------------------------------------------------------- +!> @brief calculates constitutive response +!-------------------------------------------------------------------------------------------------- +subroutine utilities_constitutiveResponse(timeinc,P_av,forwardData) + use debug, only: & + debug_reset, & + debug_info + use numerics, only: & + worldrank + use math, only: & + math_transpose33, & + math_rotate_forward33, & + math_det33 + use FEsolving, only: & + restartWrite + use homogenization, only: & + materialpoint_F0, & + materialpoint_F, & + materialpoint_P, & + materialpoint_dPdF, & + materialpoint_stressAndItsTangent + use mesh, only: & + mesh_NcpElems + + implicit none + real(pReal), intent(in) :: timeinc !< loading time + logical, intent(in) :: forwardData !< age results + + real(pReal),intent(out), dimension(3,3) :: P_av !< average PK stress + + logical :: & + age + + integer(pInt) :: & + j + real(pReal) :: defgradDetMin, defgradDetMax, defgradDet + PetscErrorCode :: ierr + + write(6,'(/,a)') ' ... evaluating constitutive response ......................................' + + age = .False. + if (forwardData) then ! aging results + age = .True. + endif + if (cutBack) then ! restore saved variables + age = .False. + endif + call debug_reset() + +!-------------------------------------------------------------------------------------------------- +! calculate bounds of det(F) and report + if(debugGeneral) then + defgradDetMax = -huge(1.0_pReal) + defgradDetMin = +huge(1.0_pReal) + do j = 1_pInt, mesh_NcpElems + defgradDet = math_det33(materialpoint_F(1:3,1:3,1,j)) + defgradDetMax = max(defgradDetMax,defgradDet) + defgradDetMin = min(defgradDetMin,defgradDet) + end do + write(6,'(a,1x,es11.4)') ' max determinant of deformation =', defgradDetMax + write(6,'(a,1x,es11.4)') ' min determinant of deformation =', defgradDetMin + flush(6) + endif + + call materialpoint_stressAndItsTangent(.true.,timeinc) ! calculate P field + + call debug_info() + + restartWrite = .false. ! reset restartWrite status + cutBack = .false. ! reset cutBack status + + P_av = sum(sum(materialpoint_P,dim=4),dim=3) * wgt ! average of P + C_volAvg = sum(sum(materialpoint_dPdF,dim=6),dim=5) * wgt + call MPI_Allreduce(MPI_IN_PLACE,P_av,9,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD,ierr) + call MPI_Allreduce(MPI_IN_PLACE,C_volAvg,81,MPI_DOUBLE,MPI_SUM,PETSC_COMM_WORLD, ierr) + +end subroutine utilities_constitutiveResponse + +!-------------------------------------------------------------------------------------------------- +!> @brief Create index sets of boundary dofs (in local and global numbering) +!-------------------------------------------------------------------------------------------------- +subroutine utilities_indexBoundaryDofs(dm_local,nFaceSets,numFields,local2global,section,localIS,globalIS) + + implicit none + + DM :: dm_local + ISLocalToGlobalMapping :: local2global + PetscSection :: section + PetscInt :: nFaceSets, numFields, nDof + IS, dimension(nFaceSets,numFields) :: localIS, globalIS + PetscInt :: field, faceSet, point, dof, offset + PetscInt :: localSize, storageSize, ISSize + PetscInt, dimension(:) , allocatable :: localIndices + IS :: faceSetIS, BC_IS, dummyIS + PetscInt, dimension(:) , pointer :: pFaceSets, pBCvertex, pBCvertexlc + DMLabel :: BCLabel + PetscErrorCode :: ierr + + call DMGetLabel(dm_local,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) + call DMPlexLabelComplete(dm_local,BCLabel,ierr); CHKERRQ(ierr) + call PetscSectionGetStorageSize(section,storageSize,ierr); CHKERRQ(ierr) + call DMGetLabelIdIS(dm_local,'Face Sets',faceSetIS,ierr); CHKERRQ(ierr) + call ISGetIndicesF90(faceSetIS,pFaceSets,ierr); CHKERRQ(ierr) + allocate(localIndices (storageSize)) + do faceSet = 1, nFaceSets + call DMGetStratumSize(dm_local,'Face Sets',pFaceSets(faceSet),ISSize,ierr) + CHKERRQ(ierr) + call DMGetStratumIS(dm_local,'Face Sets',pFaceSets(faceSet),BC_IS,ierr) + CHKERRQ(ierr) + if (ISSize > 0) call ISGetIndicesF90(BC_IS,pBCvertex,ierr) + do field = 1, numFields + localSize = 0 + do point = 1, ISSize + call PetscSectionGetFieldDof(section,pBCvertex(point),field-1,nDof,ierr) + CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,pBCvertex(point),field-1,offset,ierr) + CHKERRQ(ierr) + do dof = 1, nDof + localSize = localSize + 1 + localIndices(localSize) = offset + dof - 1 + enddo + enddo + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES, & + localIS(faceSet,field),ierr) + CHKERRQ(ierr) + call ISLocalToGlobalMappingApplyIS(local2global,localIS(faceSet,field), & + globalIS(faceSet,field),ierr) + CHKERRQ(ierr) + enddo + if (ISSize > 0) call ISRestoreIndicesF90(BC_IS,pBCvertex,ierr) + call ISDestroy(BC_IS,ierr); CHKERRQ(ierr) + enddo + call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr); CHKERRQ(ierr) + call ISDestroy(faceSetIS,ierr); CHKERRQ(ierr) + + do faceSet = 1, nFaceSets; do field = 1, numFields + call ISGetSize(globalIS(faceSet,field),ISSize,ierr); CHKERRQ(ierr) + if (ISSize > 0) then + call ISGetIndicesF90(localIS(faceSet,field),pBCvertexlc,ierr); CHKERRQ(ierr) + call ISGetIndicesF90(globalIS(faceSet,field),pBCvertex,ierr); CHKERRQ(ierr) + endif + localSize = 0 + do point = 1, ISSize + if (pBCvertex(point) >= 0) then + localSize = localSize + 1 + localIndices(localSize) = pBCvertexlc(point) + endif + enddo + if (ISSize > 0) then + call ISRestoreIndicesF90(localIS(faceSet,field),pBCvertexlc,ierr); CHKERRQ(ierr) + call ISRestoreIndicesF90(globalIS(faceSet,field),pBCvertex,ierr); CHKERRQ(ierr) + endif + call ISDestroy(globalIS(faceSet,field),ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES, & + globalIS(faceSet,field),ierr) + CHKERRQ(ierr) + if (ISSize > 0) then + call ISDuplicate(localIS(faceSet,field),dummyIS,ierr); CHKERRQ(ierr) + call ISDestroy(localIS(faceSet,field),ierr); CHKERRQ(ierr) + call ISDifference(dummyIS,globalIS(faceSet,field),localIS(faceSet,field),ierr) + CHKERRQ(ierr) + call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) + endif + enddo; enddo + deallocate(localIndices) + +end subroutine utilities_indexBoundaryDofs + +!-------------------------------------------------------------------------------------------------- +!> @brief Project BC values to local vector +!-------------------------------------------------------------------------------------------------- +subroutine utilities_projectBCValues(localVec,section,field,comp,bcPointsIS,BCValue,BCDotValue,timeinc) + + implicit none + + Vec :: localVec + PetscInt :: field, comp, nBcPoints, point, dof, numDof, numComp, offset + PetscSection :: section + IS :: bcPointsIS + PetscInt, pointer :: bcPoints(:) + PetscScalar, pointer :: localArray(:) + PetscScalar :: BCValue,BCDotValue,timeinc + PetscErrorCode :: ierr + + call PetscSectionGetFieldComponents(section,field,numComp,ierr); CHKERRQ(ierr) + call ISGetSize(bcPointsIS,nBcPoints,ierr); CHKERRQ(ierr) + if (nBcPoints > 0) call ISGetIndicesF90(bcPointsIS,bcPoints,ierr) + call VecGetArrayF90(localVec,localArray,ierr); CHKERRQ(ierr) + do point = 1, nBcPoints + call PetscSectionGetFieldDof(section,bcPoints(point),field,numDof,ierr) + CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,bcPoints(point),field,offset,ierr) + CHKERRQ(ierr) + do dof = offset+comp+1, offset+numDof, numComp + localArray(dof) = localArray(dof) + BCValue + BCDotValue*timeinc + enddo + enddo + call VecRestoreArrayF90(localVec,localArray,ierr); CHKERRQ(ierr) + call VecAssemblyBegin(localVec, ierr); CHKERRQ(ierr) + call VecAssemblyEnd (localVec, ierr); CHKERRQ(ierr) + if (nBcPoints > 0) call ISRestoreIndicesF90(bcPointsIS,bcPoints,ierr) + +end subroutine utilities_projectBCValues + +!-------------------------------------------------------------------------------------------------- +!> @brief Create index sets of boundary dofs (in local and global numbering) +!-------------------------------------------------------------------------------------------------- +subroutine utilities_indexActiveSet(field,section,x_local,f_local,localIS,globalIS) + use mesh, only: & + geomMesh + + implicit none + + ISLocalToGlobalMapping :: local2global + PetscSection :: section + Vec :: x_local, f_local + PetscInt :: field + IS :: localIS, globalIS, dummyIS + PetscScalar, dimension(:) , pointer :: x_scal, f_scal + PetscInt :: ISSize + PetscInt :: chart, chartStart, chartEnd, nDof, dof, offset + PetscInt :: localSize + PetscInt, dimension(:) , allocatable :: localIndices + PetscInt, dimension(:) , pointer :: pBCvertex, pBCvertexlc + PetscErrorCode :: ierr + + call DMGetLocalToGlobalMapping(geomMesh,local2global,ierr) + CHKERRQ(ierr) + call DMPlexGetChart(geomMesh,chartStart,chartEnd,ierr) + CHKERRQ(ierr) + call VecGetArrayF90(x_local,x_scal,ierr); CHKERRQ(ierr) + call VecGetArrayF90(f_local,f_scal,ierr); CHKERRQ(ierr) + localSize = 0 + do chart = chartStart, chartEnd-1 + call PetscSectionGetFieldDof(section,chart,field-1,nDof,ierr); CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,chart,field-1,offset,ierr); CHKERRQ(ierr) + do dof = offset+1, offset+nDof + if (((x_scal(dof) < 1.0e-8) .and. (f_scal(dof) > 0.0)) .or. & + ((x_scal(dof) > 1.0 - 1.0e-8) .and. (f_scal(dof) < 0.0))) localSize = localSize + 1 + enddo + enddo + allocate(localIndices(localSize)) + localSize = 0 + do chart = chartStart, chartEnd-1 + call PetscSectionGetFieldDof(section,chart,field-1,nDof,ierr); CHKERRQ(ierr) + call PetscSectionGetFieldOffset(section,chart,field-1,offset,ierr); CHKERRQ(ierr) + do dof = offset+1, offset+nDof + if (((x_scal(dof) < 1.0e-8) .and. (f_scal(dof) > 0.0)) .or. & + ((x_scal(dof) > 1.0 - 1.0e-8) .and. (f_scal(dof) < 0.0))) then + localSize = localSize + 1 + localIndices(localSize) = dof-1 + endif + enddo + enddo + call VecRestoreArrayF90(x_local,x_scal,ierr); CHKERRQ(ierr) + call VecRestoreArrayF90(f_local,f_scal,ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES,localIS,ierr) + CHKERRQ(ierr) + call ISLocalToGlobalMappingApplyIS(local2global,localIS,globalIS,ierr) + CHKERRQ(ierr) + call ISGetSize(globalIS,ISSize,ierr); CHKERRQ(ierr) + if (ISSize > 0) then + call ISGetIndicesF90(localIS,pBCvertexlc,ierr); CHKERRQ(ierr) + call ISGetIndicesF90(globalIS,pBCvertex,ierr); CHKERRQ(ierr) + endif + localSize = 0 + do chart = 1, ISSize + if (pBCvertex(chart) >= 0) then + localSize = localSize + 1 + localIndices(localSize) = pBCvertexlc(chart) + endif + enddo + if (ISSize > 0) then + call ISRestoreIndicesF90(localIS,pBCvertexlc,ierr); CHKERRQ(ierr) + call ISRestoreIndicesF90(globalIS,pBCvertex,ierr); CHKERRQ(ierr) + endif + call ISDestroy(globalIS,ierr); CHKERRQ(ierr) + call ISCreateGeneral(PETSC_COMM_SELF,localSize,localIndices,PETSC_COPY_VALUES,globalIS,ierr) + CHKERRQ(ierr) + if (ISSize > 0) then + call ISDuplicate(localIS,dummyIS,ierr); CHKERRQ(ierr) + call ISDestroy(localIS,ierr); CHKERRQ(ierr) + call ISDifference(dummyIS,globalIS,localIS,ierr) + CHKERRQ(ierr) + call ISDestroy(dummyIS,ierr); CHKERRQ(ierr) + endif + deallocate(localIndices) + +end subroutine utilities_indexActiveSet + +!-------------------------------------------------------------------------------------------------- +!> @brief cleans up +!-------------------------------------------------------------------------------------------------- +subroutine utilities_destroy() + !use material, only: & + ! homogenization_Ngrains + + !implicit none + !PetscInt :: homog, cryst, grain, phase + !PetscErrorCode :: ierr + + !call PetscViewerHDF5PopGroup(resUnit, ierr); CHKERRQ(ierr) + !call VecDestroy(coordinatesVec,ierr); CHKERRQ(ierr) + !do homog = 1, material_Nhomogenization + ! call VecDestroy(homogenizationResultsVec(homog),ierr);CHKERRQ(ierr) + ! do cryst = 1, material_Ncrystallite; do grain = 1, homogenization_Ngrains(homog) + ! call VecDestroy(crystalliteResultsVec(cryst,grain),ierr);CHKERRQ(ierr) + ! enddo; enddo + ! do phase = 1, material_Nphase; do grain = 1, homogenization_Ngrains(homog) + ! call VecDestroy(phaseResultsVec(phase,grain),ierr);CHKERRQ(ierr) + ! enddo; enddo + !enddo + !call PetscViewerDestroy(resUnit, ierr); CHKERRQ(ierr) + +end subroutine utilities_destroy + + +end module FEM_utilities diff --git a/src/FEM_zoo.f90 b/src/FEM_zoo.f90 new file mode 100644 index 000000000..67c518c47 --- /dev/null +++ b/src/FEM_zoo.f90 @@ -0,0 +1,350 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Interpolation data used by the FEM solver +!-------------------------------------------------------------------------------------------------- +module FEM_Zoo + use prec, only: pReal, pInt, group_float + + implicit none + private + integer(pInt), parameter, public:: & + maxOrder = 5 !< current max interpolation set at cubic (intended to be arbitrary) + real(pReal), dimension(2,3), private, protected :: & + triangle = reshape([-1.0_pReal, -1.0_pReal, & + 1.0_pReal, -1.0_pReal, & + -1.0_pReal, 1.0_pReal], shape=[2,3]) + real(pReal), dimension(3,4), private, protected :: & + tetrahedron = reshape([-1.0_pReal, -1.0_pReal, -1.0_pReal, & + 1.0_pReal, -1.0_pReal, -1.0_pReal, & + -1.0_pReal, 1.0_pReal, -1.0_pReal, & + -1.0_pReal, -1.0_pReal, 1.0_pReal], shape=[3,4]) + integer(pInt), dimension(3,maxOrder), public, protected :: & + FEM_Zoo_nQuadrature !< number of quadrature points for a given spatial dimension(1-3) and interpolation order(1-maxOrder) + type(group_float), dimension(3,maxOrder), public, protected :: & + FEM_Zoo_QuadratureWeights, & !< quadrature weights for each quadrature rule + FEM_Zoo_QuadraturePoints !< quadrature point coordinates (in simplical system) for each quadrature rule + + public :: & + FEM_Zoo_init + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes FEM interpolation data +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_init +#if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options +#endif + use IO, only: & + IO_timeStamp + + implicit none + + write(6,'(/,a)') ' <<<+- FEM_Zoo init -+>>>' + write(6,'(a)') ' $Id: FEM_Zoo.f90 4354 2015-08-04 15:04:53Z MPIE\p.shanthraj $' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + +!-------------------------------------------------------------------------------------------------- +! 2D linear + FEM_Zoo_nQuadrature(2,1) = 1 + allocate(FEM_Zoo_QuadratureWeights(2,1)%p(1)) + allocate(FEM_Zoo_QuadraturePoints (2,1)%p(2)) + FEM_Zoo_QuadratureWeights(2,1)%p(1) = 1.0_pReal + call FEM_Zoo_permutationStar3([1.0_pReal/3.0_pReal], & + FEM_Zoo_QuadraturePoints(2,1)%p(1:2)) + +!-------------------------------------------------------------------------------------------------- +! 2D quadratic + FEM_Zoo_nQuadrature(2,2) = 3 + allocate(FEM_Zoo_QuadratureWeights(2,2)%p(3)) + allocate(FEM_Zoo_QuadraturePoints (2,2)%p(6)) + FEM_Zoo_QuadratureWeights(2,2)%p(1:3) = 1.0_pReal/3.0_pReal + call FEM_Zoo_permutationStar21([1.0_pReal/6.0_pReal], & + FEM_Zoo_QuadraturePoints(2,2)%p(1:6)) + +!-------------------------------------------------------------------------------------------------- +! 2D cubic + FEM_Zoo_nQuadrature(2,3) = 6 + allocate(FEM_Zoo_QuadratureWeights(2,3)%p(6 )) + allocate(FEM_Zoo_QuadraturePoints (2,3)%p(12)) + FEM_Zoo_QuadratureWeights(2,3)%p(1:3) = 0.22338158967801146570_pReal + call FEM_Zoo_permutationStar21([0.44594849091596488632_pReal], & + FEM_Zoo_QuadraturePoints(2,3)%p(1:6)) + FEM_Zoo_QuadratureWeights(2,3)%p(4:6) = 0.10995174365532186764_pReal + call FEM_Zoo_permutationStar21([0.091576213509770743460_pReal], & + FEM_Zoo_QuadraturePoints(2,3)%p(7:12)) + +!-------------------------------------------------------------------------------------------------- +! 2D quartic + FEM_Zoo_nQuadrature(2,4) = 12 + allocate(FEM_Zoo_QuadratureWeights(2,4)%p(12)) + allocate(FEM_Zoo_QuadraturePoints (2,4)%p(24)) + FEM_Zoo_QuadratureWeights(2,4)%p(1:3) = 0.11678627572638_pReal + call FEM_Zoo_permutationStar21([0.24928674517091_pReal], & + FEM_Zoo_QuadraturePoints(2,4)%p(1:6)) + FEM_Zoo_QuadratureWeights(2,4)%p(4:6) = 0.05084490637021_pReal + call FEM_Zoo_permutationStar21([0.06308901449150_pReal], & + FEM_Zoo_QuadraturePoints(2,4)%p(7:12)) + FEM_Zoo_QuadratureWeights(2,4)%p(7:12) = 0.08285107561837_pReal + call FEM_Zoo_permutationStar111([0.31035245103378_pReal, 0.63650249912140_pReal], & + FEM_Zoo_QuadraturePoints(2,4)%p(13:24)) + +!-------------------------------------------------------------------------------------------------- +! 2D order 5 + FEM_Zoo_nQuadrature(2,5) = 16 + allocate(FEM_Zoo_QuadratureWeights(2,5)%p(16)) + allocate(FEM_Zoo_QuadraturePoints (2,5)%p(32)) + FEM_Zoo_QuadratureWeights(2,5)%p(1 ) = 0.14431560767779_pReal + call FEM_Zoo_permutationStar3([0.33333333333333_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(1:2)) + FEM_Zoo_QuadratureWeights(2,5)%p(2:4) = 0.09509163426728_pReal + call FEM_Zoo_permutationStar21([0.45929258829272_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(3:8)) + FEM_Zoo_QuadratureWeights(2,5)%p(5:7) = 0.10321737053472_pReal + call FEM_Zoo_permutationStar21([0.17056930775176_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(9:14)) + FEM_Zoo_QuadratureWeights(2,5)%p(8:10) = 0.03245849762320_pReal + call FEM_Zoo_permutationStar21([0.05054722831703_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(15:20)) + FEM_Zoo_QuadratureWeights(2,5)%p(11:16) = 0.02723031417443_pReal + call FEM_Zoo_permutationStar111([0.26311282963464_pReal, 0.72849239295540_pReal], & + FEM_Zoo_QuadraturePoints(2,5)%p(21:32)) + +!-------------------------------------------------------------------------------------------------- +! 3D linear + FEM_Zoo_nQuadrature(3,1) = 1 + allocate(FEM_Zoo_QuadratureWeights(3,1)%p(1)) + allocate(FEM_Zoo_QuadraturePoints (3,1)%p(3)) + FEM_Zoo_QuadratureWeights(3,1)%p(1) = 1.0_pReal + call FEM_Zoo_permutationStar4([0.25_pReal], & + FEM_Zoo_QuadraturePoints(3,1)%p(1:3)) + +!-------------------------------------------------------------------------------------------------- +! 3D quadratic + FEM_Zoo_nQuadrature(3,2) = 4 + allocate(FEM_Zoo_QuadratureWeights(3,2)%p(4 )) + allocate(FEM_Zoo_QuadraturePoints (3,2)%p(12)) + FEM_Zoo_QuadratureWeights(3,2)%p(1:4) = 0.25_pReal + call FEM_Zoo_permutationStar31([0.13819660112501051518_pReal], & + FEM_Zoo_QuadraturePoints(3,2)%p(1:12)) + +!-------------------------------------------------------------------------------------------------- +! 3D cubic + FEM_Zoo_nQuadrature(3,3) = 14 + allocate(FEM_Zoo_QuadratureWeights(3,3)%p(14)) + allocate(FEM_Zoo_QuadraturePoints (3,3)%p(42)) + FEM_Zoo_QuadratureWeights(3,3)%p(1:4) = 0.073493043116361949544_pReal + call FEM_Zoo_permutationStar31([0.092735250310891226402_pReal], & + FEM_Zoo_QuadraturePoints(3,3)%p(1:12)) + FEM_Zoo_QuadratureWeights(3,3)%p(5:8) = 0.11268792571801585080_pReal + call FEM_Zoo_permutationStar31([0.31088591926330060980_pReal], & + FEM_Zoo_QuadraturePoints(3,3)%p(13:24)) + FEM_Zoo_QuadratureWeights(3,3)%p(9:14) = 0.042546020777081466438_pReal + call FEM_Zoo_permutationStar22([0.045503704125649649492_pReal], & + FEM_Zoo_QuadraturePoints(3,3)%p(25:42)) + +!-------------------------------------------------------------------------------------------------- +! 3D quartic + FEM_Zoo_nQuadrature(3,4) = 35 + allocate(FEM_Zoo_QuadratureWeights(3,4)%p(35)) + allocate(FEM_Zoo_QuadraturePoints (3,4)%p(105)) + FEM_Zoo_QuadratureWeights(3,4)%p(1:4) = 0.0021900463965388_pReal + call FEM_Zoo_permutationStar31([0.0267367755543735_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(1:12)) + FEM_Zoo_QuadratureWeights(3,4)%p(5:16) = 0.0143395670177665_pReal + call FEM_Zoo_permutationStar211([0.0391022406356488_pReal, 0.7477598884818090_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(13:48)) + FEM_Zoo_QuadratureWeights(3,4)%p(17:22) = 0.0250305395686746_pReal + call FEM_Zoo_permutationStar22([0.4547545999844830_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(49:66)) + FEM_Zoo_QuadratureWeights(3,4)%p(23:34) = 0.0479839333057554_pReal + call FEM_Zoo_permutationStar211([0.2232010379623150_pReal, 0.0504792790607720_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(67:102)) + FEM_Zoo_QuadratureWeights(3,4)%p(35) = 0.0931745731195340_pReal + call FEM_Zoo_permutationStar4([0.25_pReal], & + FEM_Zoo_QuadraturePoints(3,4)%p(103:105)) +!-------------------------------------------------------------------------------------------------- +! 3D quintic + FEM_Zoo_nQuadrature(3,5) = 56 + allocate(FEM_Zoo_QuadratureWeights(3,5)%p(56)) + allocate(FEM_Zoo_QuadraturePoints (3,5)%p(168)) + FEM_Zoo_QuadratureWeights(3,5)%p(1:4) = 0.0010373112336140_pReal + call FEM_Zoo_permutationStar31([0.0149520651530592_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(1:12)) + FEM_Zoo_QuadratureWeights(3,5)%p(5:16) = 0.0096016645399480_pReal + call FEM_Zoo_permutationStar211([0.0340960211962615_pReal, 0.1518319491659370_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(13:48)) + FEM_Zoo_QuadratureWeights(3,5)%p(17:28) = 0.0164493976798232_pReal + call FEM_Zoo_permutationStar211([0.0462051504150017_pReal, 0.3549340560639790_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(49:84)) + FEM_Zoo_QuadratureWeights(3,5)%p(29:40) = 0.0153747766513310_pReal + call FEM_Zoo_permutationStar211([0.2281904610687610_pReal, 0.0055147549744775_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(85:120)) + FEM_Zoo_QuadratureWeights(3,5)%p(41:52) = 0.0293520118375230_pReal + call FEM_Zoo_permutationStar211([0.3523052600879940_pReal, 0.0992057202494530_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(121:156)) + FEM_Zoo_QuadratureWeights(3,5)%p(53:56) = 0.0366291366405108_pReal + call FEM_Zoo_permutationStar31([0.1344783347929940_pReal], & + FEM_Zoo_QuadraturePoints(3,5)%p(157:168)) + +end subroutine FEM_Zoo_init + +!-------------------------------------------------------------------------------------------------- +!> @brief star 3 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar3(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(2,1), temp(3,1) + + temp(:,1) = [point(1), point(1), point(1)] + qPt = matmul(triangle, temp) + +end subroutine FEM_Zoo_permutationStar3 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 21 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar21(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(2,3), temp(3,3) + + temp(:,1) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1)] + temp(:,2) = [point(1), 1.0_pReal - 2.0_pReal*point(1), point(1)] + temp(:,3) = [1.0_pReal - 2.0_pReal*point(1), point(1), point(1)] + qPt = matmul(triangle, temp) + +end subroutine FEM_Zoo_permutationStar21 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 111 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar111(point,qPt) + + implicit none + real(pReal) :: point(2), qPt(2,6), temp(3,6) + + temp(:,1) = [point(1), point(2), 1.0_pReal - point(1) - point(2)] + temp(:,2) = [point(1), 1.0_pReal - point(1) - point(2), point(2)] + temp(:,4) = [point(2), 1.0_pReal - point(1) - point(2), point(1)] + temp(:,5) = [1.0_pReal - point(1) - point(2), point(2), point(1)] + temp(:,6) = [1.0_pReal - point(1) - point(2), point(1), point(2)] + qPt = matmul(triangle, temp) + +end subroutine FEM_Zoo_permutationStar111 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 4 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar4(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(3,1), temp(4,1) + + temp(:,1) = [point(1), point(1), point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar4 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 31 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar31(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(3,4), temp(4,4) + + temp(:,1) = [point(1), point(1), point(1), 1.0_pReal - 3.0_pReal*point(1)] + temp(:,2) = [point(1), point(1), 1.0_pReal - 3.0_pReal*point(1), point(1)] + temp(:,3) = [point(1), 1.0_pReal - 3.0_pReal*point(1), point(1), point(1)] + temp(:,4) = [1.0_pReal - 3.0_pReal*point(1), point(1), point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar31 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 22 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar22(point,qPt) + + implicit none + real(pReal) :: point(1), qPt(3,6), temp(4,6) + + temp(:,1) = [point(1), point(1), 0.5_pReal - point(1), 0.5_pReal - point(1)] + temp(:,2) = [point(1), 0.5_pReal - point(1), point(1), 0.5_pReal - point(1)] + temp(:,3) = [0.5_pReal - point(1), point(1), point(1), 0.5_pReal - point(1)] + temp(:,4) = [0.5_pReal - point(1), point(1), 0.5_pReal - point(1), point(1)] + temp(:,5) = [0.5_pReal - point(1), 0.5_pReal - point(1), point(1), point(1)] + temp(:,6) = [point(1), 0.5_pReal - point(1), 0.5_pReal - point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar22 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 211 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar211(point,qPt) + + implicit none + real(pReal) :: point(2), qPt(3,12), temp(4,12) + + temp(:,1 ) = [point(1), point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2)] + temp(:,2 ) = [point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2)] + temp(:,3 ) = [point(1), point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)] + temp(:,4 ) = [point(1), point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)] + temp(:,5 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2)] + temp(:,6 ) = [point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1)] + temp(:,7 ) = [point(2), point(1), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2)] + temp(:,8 ) = [point(2), point(1), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1)] + temp(:,9 ) = [point(2), 1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1)] + temp(:,10) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(1), point(2)] + temp(:,11) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(1), point(2), point(1)] + temp(:,12) = [1.0_pReal - 2.0_pReal*point(1) - point(2), point(2), point(1), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar211 + +!-------------------------------------------------------------------------------------------------- +!> @brief star 1111 permutation of input +!-------------------------------------------------------------------------------------------------- +subroutine FEM_Zoo_permutationStar1111(point,qPt) + + implicit none + real(pReal) :: point(3), qPt(3,24), temp(4,24) + + temp(:,1 ) = [point(1), point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,2 ) = [point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3)] + temp(:,3 ) = [point(1), point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,4 ) = [point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2)] + temp(:,5 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(3)] + temp(:,6 ) = [point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(2)] + temp(:,7 ) = [point(2), point(1), point(3), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,8 ) = [point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(3)] + temp(:,9 ) = [point(2), point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,10) = [point(2), point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1)] + temp(:,11) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(3)] + temp(:,12) = [point(2), 1.0_pReal - point(1) - point(2)- point(3), point(3), point(1)] + temp(:,13) = [point(3), point(1), point(2), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,14) = [point(3), point(1), 1.0_pReal - point(1) - point(2)- point(3), point(2)] + temp(:,15) = [point(3), point(2), point(1), 1.0_pReal - point(1) - point(2)- point(3)] + temp(:,16) = [point(3), point(2), 1.0_pReal - point(1) - point(2)- point(3), point(1)] + temp(:,17) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(1), point(2)] + temp(:,18) = [point(3), 1.0_pReal - point(1) - point(2)- point(3), point(2), point(1)] + temp(:,19) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(2), point(3)] + temp(:,20) = [1.0_pReal - point(1) - point(2)- point(3), point(1), point(3), point(2)] + temp(:,21) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(1), point(3)] + temp(:,22) = [1.0_pReal - point(1) - point(2)- point(3), point(2), point(3), point(1)] + temp(:,23) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(1), point(2)] + temp(:,24) = [1.0_pReal - point(1) - point(2)- point(3), point(3), point(2), point(1)] + qPt = matmul(tetrahedron, temp) + +end subroutine FEM_Zoo_permutationStar1111 + + +end module FEM_Zoo diff --git a/src/FEsolving.f90 b/src/FEsolving.f90 index 3853cb37f..f31500c26 100644 --- a/src/FEsolving.f90 +++ b/src/FEsolving.f90 @@ -81,20 +81,13 @@ subroutine FE_init modelName = getSolverJobName() #if defined(Spectral) || defined(FEM) - -#ifdef Spectral - restartInc = spectralRestartInc -#endif -#ifdef FEM - restartInc = FEMRestartInc -#endif + restartInc = interface_RestartInc if(restartInc < 0_pInt) then call IO_warning(warning_ID=34_pInt) restartInc = 0_pInt endif restartRead = restartInc > 0_pInt ! only read in if "true" restart requested - #else call IO_open_inputFile(FILEUNIT,modelName) rewind(FILEUNIT) diff --git a/src/HDF5_utilities.f90 b/src/HDF5_utilities.f90 new file mode 100644 index 000000000..e2b0c2450 --- /dev/null +++ b/src/HDF5_utilities.f90 @@ -0,0 +1,1334 @@ +module HDF5_Utilities + use prec + use IO + use HDF5 +#ifdef PETSc + use PETSC +#endif + + integer(HID_T), public, protected :: tempCoordinates, tempResults + integer(HID_T), private :: resultsFile, currentIncID, plist_id + integer(pInt), private :: currentInc + + public :: & + HDF5_Utilities_init, & + HDF5_mappingPhase, & + HDF5_mappingHomog, & + HDF5_mappingCrystallite, & + HDF5_backwardMappingPhase, & + HDF5_backwardMappingHomog, & + HDF5_backwardMappingCrystallite, & + HDF5_mappingCells, & + HDF5_addGroup ,& + HDF5_closeGroup ,& + HDF5_openGroup, & + HDF5_forwardResults, & + HDF5_writeVectorDataset, & + HDF5_writeScalarDataset, & + HDF5_writeTensorDataset, & + HDF5_closeJobFile, & + HDF5_removeLink +contains + +subroutine HDF5_Utilities_init + use, intrinsic :: & + iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + + implicit none + integer :: hdferr + integer(SIZE_T) :: typeSize + + write(6,'(/,a)') ' <<<+- HDF5_Utilities init -+>>>' +#include "compilation_info.f90" + + currentInc = -1_pInt + call HDF5_createJobFile + +end subroutine HDF5_Utilities_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates and initializes HDF5 output files +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_createJobFile + use hdf5 + use DAMASK_interface, only: & + getSolverJobName + + implicit none + integer :: hdferr + integer(SIZE_T) :: typeSize + character(len=1024) :: path +#ifdef PETSc +#include +#endif + +!-------------------------------------------------------------------------------------------------- +! initialize HDF5 library and check if integer and float type size match + call h5open_f(hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5open_f') + call h5tget_size_f(H5T_NATIVE_INTEGER,typeSize, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5tget_size_f (int)') + if (int(pInt,SIZE_T)/=typeSize) call IO_error(0_pInt,ext_msg='pInt does not match H5T_NATIVE_INTEGER') + call h5tget_size_f(H5T_NATIVE_DOUBLE,typeSize, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5tget_size_f (double)') + if (int(pReal,SIZE_T)/=typeSize) call IO_error(0_pInt,ext_msg='pReal does not match H5T_NATIVE_DOUBLE') + +#ifdef PETSC + call h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pcreate_f') + call h5pset_fapl_mpio_f(plist_id, PETSC_COMM_WORLD, MPI_INFO_NULL, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_Utilities_init: h5pset_fapl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! open file + path = trim(getSolverJobName())//'.'//'hdf5' + !call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr) + call h5fcreate_f(path,H5F_ACC_TRUNC_F,resultsFile,hdferr,access_prp = plist_id) + if (hdferr < 0) call IO_error(100_pInt,ext_msg=path) + call HDF5_addStringAttribute(resultsFile,'createdBy',DAMASKVERSION) + call h5pclose_f(plist_id, hdferr) !neu + +end subroutine HDF5_createJobFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates and initializes HDF5 output file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_closeJobFile() + use hdf5 + + implicit none + integer :: hdferr + call HDF5_removeLink('current') + call h5fclose_f(resultsFile,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_closeJobFile: h5fclose_f',el=hdferr) + CALL h5close_f(hdferr) + +end subroutine HDF5_closeJobFile + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file, or if loc is present at the given location +!-------------------------------------------------------------------------------------------------- +integer(HID_T) function HDF5_addGroup(path) + use hdf5 + + implicit none + character(len=*), intent(in) :: path + integer :: hdferr + + call h5gcreate_f(resultsFile, trim(path), HDF5_addGroup, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_addGroup: h5gcreate_f ('//trim(path)//')') + +end function HDF5_addGroup + + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +integer(HID_T) function HDF5_openGroup(path) + use hdf5 + + implicit none + character(len=*), intent(in) :: path + integer :: hdferr + + call h5gopen_f(resultsFile, trim(path), HDF5_openGroup, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_openGroup: h5gopen_f ('//trim(path)//')') + +end function HDF5_openGroup + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_setLink(path,link) + use hdf5 + + implicit none + character(len=*), intent(in) :: path, link + integer :: hdferr + logical :: linkExists + + call h5lexists_f(resultsFile, link,linkExists, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lexists_soft_f ('//trim(link)//')') + if (linkExists) then + call h5ldelete_f(resultsFile,link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5ldelete_soft_f ('//trim(link)//')') + endif + call h5lcreate_soft_f(path, resultsFile, link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_setLink: h5lcreate_soft_f ('//trim(path)//' '//trim(link)//')') + +end subroutine HDF5_setLink + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_removeLink(link) + use hdf5 + + implicit none + character(len=*), intent(in) :: link + integer :: hdferr + + call h5ldelete_f(resultsFile,link, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_removeLink: h5ldelete_soft_f ('//trim(link)//')') + +end subroutine HDF5_removeLink + + + +!-------------------------------------------------------------------------------------------------- +!> @brief closes a group +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_closeGroup(ID) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: ID + integer :: hdferr + + call h5gclose_f(ID, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg = 'HDF5_closeGroup: h5gclose_f (el is ID)', el = int(ID,pInt)) + +end subroutine HDF5_closeGroup + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds a new group to the results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addStringAttribute(entity,attrLabel,attrValue) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: entity + character(len=*), intent(in) :: attrLabel, attrValue + integer :: hdferr + integer(HID_T) :: attr_id, space_id, type_id + + call h5screate_f(H5S_SCALAR_F,space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5screate_f') + call h5tcopy_f(H5T_NATIVE_CHARACTER, type_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tcopy_f') + call h5tset_size_f(type_id, int(len(trim(attrValue)),HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5tset_size_f') + call h5acreate_f(entity, trim(attrLabel),type_id,space_id,attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5acreate_f') + call h5awrite_f(attr_id, type_id, trim(attrValue), int([1],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5awrite_f') + call h5aclose_f(attr_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5aclose_f') + call h5sclose_f(space_id,hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_addStringAttribute: h5sclose_f') + +end subroutine HDF5_addStringAttribute + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingPhase(mapping,mapping2,Nconstituents,material_phase,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) + use hdf5 + + implicit none + integer(pInt), intent(in) :: Nconstituents, dataspace_size, mpiOffset + integer(pInt), intent(in), dimension(:) :: mapping, mapping2 + character(len=*), intent(in), dimension(:) :: phase_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_phase + integer(pInt), intent(in), dimension(:,:,:) :: material_phase + + character(len=len(phase_name(1))), dimension(:), allocatable :: namesNA + character(len=len(phase_name(1))) :: a + character(len=*),parameter :: n = "NULL" + + integer(pInt) :: hdferr, NmatPoints, i, j, k + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(2) :: counter + integer(HSSIZE_T), dimension(2) :: fileOffset + integer(pInt), dimension(:,:), allocatable :: arrOffset + + a = n + allocate(namesNA(0:size(phase_name)),source=[a,phase_name]) + NmatPoints = size(mapping,1)/Nconstituents + mapping_ID = HDF5_openGroup("current/mapGeometry") + + allocate(arrOffset(Nconstituents,NmatPoints)) + do i=1_pInt, NmatPoints + do k=1_pInt, Nconstituents + do j=1_pInt, size(phase_name) + if(material_phase(k,1,i) == j) & + arrOffset(k,i) = mpiOffset_phase(j) + enddo + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([Nconstituents,dataspace_size],HSIZE_T), space_id, hdferr, & + int([Nconstituents,dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(phase_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) + type_size = type_sizec + type_sizei + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'constitutive', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter(1) = Nconstituents ! how big i am + counter(2) = NmatPoints + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = mpiOffset + + call h5screate_simple_f(2, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, reshape(namesNA(mapping),[Nconstituents,NmatPoints]), & + int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, position_id, reshape(mapping2-1_pInt,[Nconstituents,NmatPoints])+arrOffset, & + int([Nconstituents, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +! close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5tclose_f instance_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingPhase: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingPhase + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingPhase(material_phase,phasememberat,phase_name,dataspace_size,mpiOffset,mpiOffset_phase) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:,:) :: material_phase, phasememberat + character(len=*), intent(in), dimension(:) :: phase_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_phase + integer(pInt), intent(in) :: mpiOffset + + integer(pInt) :: hdferr, NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: phaseID + + Nconstituents = size(phasememberat,1) + NmatPoints = count(material_phase /=0_pInt)/Nconstituents + + allocate(arr(2,NmatPoints*Nconstituents)) + + do i=1_pInt, NmatPoints + do j=Nconstituents-1_pInt, 0_pInt, -1_pInt + arr(1,Nconstituents*i-j) = i-1_pInt + enddo + enddo + arr(2,:) = pack(material_phase,material_phase/=0_pInt) + + + do i=1_pInt, size(phase_name) + write(phaseID, '(i0)') i + mapping_ID = HDF5_openGroup('/current/constitutive/'//trim(phaseID)//'_'//phase_name(i)) + NmatPoints = count(material_phase == i) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset_phase(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset, int([dataspace_size(i)],HSIZE_T),& + hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingPhase: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingPhase + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat + character(len=*), intent(in), dimension(:) :: homogenization_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_homog + integer(pInt), intent(in) :: dataspace_size, mpiOffset + + integer(pInt) :: hdferr, NmatPoints, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, position_id, plist_id, memspace + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: arrOffset + + NmatPoints = count(material_homog /=0_pInt) + mapping_ID = HDF5_openGroup("current/mapGeometry") + + allocate(arrOffset(NmatPoints)) + do i=1_pInt, NmatPoints + do j=1_pInt, size(homogenization_name) + if(material_homog(1,i) == j) & + arrOffset(i) = mpiOffset_homog(j) + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & + int([dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(homogenization_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE,type_sizei, hdferr) + type_size = type_sizec + type_sizei + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 0') + call h5tinsert_f(dtype_id, "Position", type_sizec, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f 2') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'homogenization', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f instance_id') + + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- +! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, homogenization_name(pack(material_homog,material_homog/=0_pInt)), & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f position_id') + + call h5dwrite_f(dset_id, position_id, pack(homogmemberat-1_pInt,homogmemberat/=0_pInt) + arrOffset, & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5tclose_f instance_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingHomog: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + +end subroutine HDF5_mappingHomog + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingHomog(material_homog,homogmemberat,homogenization_name,dataspace_size,mpiOffset,mpiOffset_homog) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: material_homog, homogmemberat + character(len=*), intent(in), dimension(:) :: homogenization_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_homog + integer(pInt), intent(in) :: mpiOffset + + integer(pInt) :: hdferr, NmatPoints, i + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: homogID + + NmatPoints = count(material_homog /=0_pInt) + allocate(arr(2,NmatPoints)) + + arr(1,:) = (/(i, i=0_pint,NmatPoints-1_pInt)/) + arr(2,:) = pack(material_homog,material_homog/=0_pInt) + + do i=1_pInt, size(homogenization_name) + write(homogID, '(i0)') i + mapping_ID = HDF5_openGroup('/current/homogenization/'//trim(homogID)//'_'//homogenization_name(i)) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset_homog(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i)+mpiOffset,int([dataspace_size(i)],HSIZE_T),& + hdferr, file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingHomog: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingHomog + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: crystalliteAt + integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt + character(len=*), intent(in), dimension(:) :: crystallite_name + integer(pInt), intent(in), dimension(:) :: mpiOffset_cryst + integer(pInt), intent(in) :: dataspace_size, mpiOffset + + integer :: hdferr + integer(pInt) :: NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, name_id, plist_id, memspace + integer(HID_T), dimension(:), allocatable :: position_id + + integer(HID_T) :: dt5_id ! Memory datatype identifier + integer(SIZE_T) :: typesize, type_sizec, type_sizei, type_size + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + integer(pInt), dimension(:), allocatable :: arrOffset + + character(len=64) :: m + + Nconstituents = size(crystmemberAt,1) + NmatPoints = count(crystalliteAt /=0_pInt) + mapping_ID = HDF5_openGroup("current/mapGeometry") + + allocate(position_id(Nconstituents)) + + allocate(arrOffset(NmatPoints)) + do i=1_pInt, NmatPoints + do j=1_pInt, size(crystallite_name) + if(crystalliteAt(1,i) == j) & + arrOffset(i) = Nconstituents*mpiOffset_cryst(j) + enddo + enddo + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([dataspace_size],HSIZE_T), space_id, hdferr, & + int([dataspace_size],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping') + +!-------------------------------------------------------------------------------------------------- +! compound type + ! First calculate total size by calculating sizes of each member + ! + CALL h5tcopy_f(H5T_NATIVE_CHARACTER, dt5_id, hdferr) + typesize = len(crystallite_name(1)) + CALL h5tset_size_f(dt5_id, typesize, hdferr) + CALL h5tget_size_f(dt5_id, type_sizec, hdferr) + CALL h5tget_size_f(H5T_STD_I32LE, type_sizei, hdferr) + type_size = type_sizec + type_sizei*Nconstituents + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 0') + do i=1_pInt, Nconstituents + write(m, '(i0)') i + call h5tinsert_f(dtype_id, "Position "//trim(m), type_sizec+(i-1)*type_sizei, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f 2 '//trim(m)) + enddo + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, 'crystallite', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite') + +!-------------------------------------------------------------------------------------------------- +! Create memory types (one compound datatype for each member) + call h5tcreate_f(H5T_COMPOUND_F, int(type_sizec,SIZE_T), name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f instance_id') + call h5tinsert_f(name_id, "Name", 0_SIZE_T, dt5_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f instance_id') + + do i=1_pInt, Nconstituents + write(m, '(i0)') i + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id(i), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id(i), "Position "//trim(m), 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tinsert_f position_id') + enddo + +!-------------------------------------------------------------------------------------------------- +! Define and select hyperslabs + counter = NmatPoints ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, name_id, crystallite_name(pack(crystalliteAt,crystalliteAt/=0_pInt)), & + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f position_id') + + do i=1_pInt, Nconstituents + call h5dwrite_f(dset_id, position_id(i), pack(crystmemberAt(i,:,:)-1_pInt,crystmemberAt(i,:,:)/=0_pInt)+arrOffset,& + int([dataspace_size],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dwrite_f instance_id') + enddo + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f dtype_id') + do i=1_pInt, Nconstituents + call h5tclose_f(position_id(i), hdferr) + enddo + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f position_id') + call h5tclose_f(name_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5tclose_f instance_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCrystallite: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + +end subroutine HDF5_mappingCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the backward mapping from spatial position and constituent ID to results +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_backwardMappingCrystallite(crystalliteAt,crystmemberAt,crystallite_name,dataspace_size,mpiOffset,mpiOffset_cryst) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:,:) :: crystalliteAt + integer(pInt), intent(in), dimension(:,:,:) :: crystmemberAt + character(len=*), intent(in), dimension(:) :: crystallite_name + integer(pInt), intent(in), dimension(:) :: dataspace_size, mpiOffset_cryst + integer(pInt), intent(in) :: mpiOffset + + integer :: hdferr + integer(pInt) :: NmatPoints, Nconstituents, i, j + integer(HID_T) :: mapping_id, dtype_id, dset_id, space_id, position_id, plist_id, memspace + integer(SIZE_T) :: type_size + + integer(pInt), dimension(:,:), allocatable :: h_arr, arr + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + character(len=64) :: crystallID + + Nconstituents = size(crystmemberAt,1) + NmatPoints = count(crystalliteAt /=0_pInt) + + allocate(h_arr(2,NmatPoints)) + allocate(arr(2,Nconstituents*NmatPoints)) + + h_arr(1,:) = (/(i, i=0_pInt,NmatPoints-1_pInt)/) + h_arr(2,:) = pack(crystalliteAt,crystalliteAt/=0_pInt) + + do i=1_pInt, NmatPoints + do j=Nconstituents-1_pInt, 0_pInt, -1_pInt + arr(1,Nconstituents*i-j) = h_arr(1,i) + arr(2,Nconstituents*i-j) = h_arr(2,i) + enddo + enddo + + + do i=1_pInt, size(crystallite_name) + if (crystallite_name(i) == 'none') cycle + write(crystallID, '(i0)') i + mapping_ID = HDF5_openGroup('/current/crystallite/'//trim(crystallID)//'_'//crystallite_name(i)) + NmatPoints = count(crystalliteAt == i) + +!-------------------------------------------------------------------------------------------------- + ! create dataspace + call h5screate_simple_f(1, int([Nconstituents*dataspace_size(i)],HSIZE_T), space_id, hdferr, & + int([Nconstituents*dataspace_size(i)],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping') + +!-------------------------------------------------------------------------------------------------- + ! compound type + call h5tget_size_f(H5T_STD_I32LE, type_size, hdferr) + call h5tcreate_f(H5T_COMPOUND_F, type_size, dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeBackwardMapping: h5tcreate_f dtype_id') + + call h5tinsert_f(dtype_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f 0') + +!-------------------------------------------------------------------------------------------------- + ! create Dataset + call h5dcreate_f(mapping_id, 'mapGeometry', dtype_id, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite') + +!-------------------------------------------------------------------------------------------------- + ! Create memory types + call h5tcreate_f(H5T_COMPOUND_F, int(pInt,SIZE_T), position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tcreate_f position_id') + call h5tinsert_f(position_id, "Position", 0_SIZE_T, H5T_STD_I32LE, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tinsert_f position_id') + +!-------------------------------------------------------------------------------------------------- + ! Define and select hyperslabs + counter = Nconstituents*NmatPoints ! how big i am + fileOffset = Nconstituents*mpiOffset_cryst(i) ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sselect_hyperslab_f') + +!-------------------------------------------------------------------------------------------------- + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pset_dxpl_mpio_f') +#endif + +!-------------------------------------------------------------------------------------------------- + ! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, position_id, pack(arr(1,:),arr(2,:)==i) + mpiOffset,& + int([Nconstituents*dataspace_size(i)],HSIZE_T), hdferr, file_space_id = space_id, & + mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- + !close types, dataspaces + call h5tclose_f(dtype_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f dtype_id') + call h5tclose_f(position_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5tclose_f position_id') + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5sclose_f') + call h5pclose_f(plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_backwardMappingCrystallite: h5pclose_f') + call HDF5_closeGroup(mapping_ID) + + enddo + +end subroutine HDF5_backwardMappingCrystallite + + +!-------------------------------------------------------------------------------------------------- +!> @brief adds the unique cell to node mapping +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_mappingCells(mapping) + use hdf5 + + implicit none + integer(pInt), intent(in), dimension(:) :: mapping + + integer :: hdferr, Nnodes + integer(HID_T) :: mapping_id, dset_id, space_id + + Nnodes=size(mapping) + mapping_ID = HDF5_openGroup("mapping") + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & + int([Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(mapping_id, "Cell",H5T_NATIVE_INTEGER, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells') + +!-------------------------------------------------------------------------------------------------- +! write data by fields in the datatype. Fields order is not important. + call h5dwrite_f(dset_id, H5T_NATIVE_INTEGER, mapping, int([Nnodes],HSIZE_T), hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingCells: h5dwrite_f instance_id') + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5dclose_f') + call h5sclose_f(space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='IO_mappingConstitutive: h5sclose_f') + call HDF5_closeGroup(mapping_ID) + +end subroutine HDF5_mappingCells + + + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addTensor3DDataset(group,Nnodes,tensorSize,label,SIunit) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + integer(pInt), intent(in) :: Nnodes, tensorSize + character(len=*), intent(in) :: SIunit, label + + integer :: hdferr + integer(HID_T) :: space_id, dset_id + integer(HSIZE_T), dimension(3) :: dataShape + + dataShape = int([tensorSize,tensorSize,Nnodes], HSIZE_T) + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(3, dataShape, space_id, hdferr, dataShape) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(group, trim(label),H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5dcreate_f') + call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addTensor3DDataset: h5dclose_f') + call h5sclose_f(space_id, hdferr) + +end subroutine HDF5_addTensor3DDataset + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_writeVectorDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + character(len=*), intent(in) :: SIunit,label + integer(pInt), intent(in) :: dataspace_size, mpiOffset + real(pReal), intent(in), dimension(:,:) :: dataset + + integer :: hdferr, vectorSize + integer(HID_T) :: dset_id, space_id, memspace, plist_id + + integer(HSIZE_T), dimension(2) :: counter + integer(HSSIZE_T), dimension(2) :: fileOffset + + if(any(shape(dataset) == 0)) return + + vectorSize = size(dataset,1) + + call HDF5_addVectorDataset(group,dataspace_size,vectorSize,label,SIunit) ! here nNodes need to be global + call h5dopen_f(group, label, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dopen_f') + + ! Define and select hyperslabs + counter(1) = vectorSize ! how big i am + counter(2) = size(dataset,2) + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = mpiOffset + + call h5screate_simple_f(2, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5sselect_hyperslab_f') + + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5pset_dxpl_mpio_f') +#endif + + ! Write the dataset collectively + call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([vectorSize, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeVectorDataset: h5dwrite_f') + + call h5sclose_f(space_id, hdferr) + call h5sclose_f(memspace, hdferr) + call h5dclose_f(dset_id, hdferr) + call h5pclose_f(plist_id, hdferr) + +end subroutine HDF5_writeVectorDataset + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +! by default, a 3x3 tensor is assumed +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_writeTensorDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + character(len=*), intent(in) :: SIunit,label + integer(pInt), intent(in) :: dataspace_size, mpiOffset + real(pReal), intent(in), dimension(:,:,:) :: dataset + + integer :: hdferr, tensorSize + integer(HID_T) :: dset_id, space_id, memspace, plist_id + + integer(HSIZE_T), dimension(3) :: counter + integer(HSSIZE_T), dimension(3) :: fileOffset + + if(any(shape(dataset) == 0)) return + + tensorSize = size(dataset,1) + + call HDF5_addTensor3DDataset(group,dataspace_size,tensorSize,label,SIunit) + call h5dopen_f(group, label, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dopen_f') + + ! Define and select hyperslabs + counter(1) = tensorSize ! how big i am + counter(2) = tensorSize + counter(3) = size(dataset,3) + fileOffset(1) = 0 ! where i start to write my data + fileOffset(2) = 0 + fileOffset(3) = mpiOffset + + call h5screate_simple_f(3, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5sselect_hyperslab_f') + + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5pset_dxpl_mpio_f') +#endif + + ! Write the dataset collectively + call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([tensorSize, dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeTensorDataset: h5dwrite_f') + + call h5sclose_f(space_id, hdferr) + call h5sclose_f(memspace, hdferr) + call h5dclose_f(dset_id, hdferr) + call h5pclose_f(plist_id, hdferr) + + end subroutine HDF5_writeTensorDataset + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addVectorDataset(group,nnodes,vectorSize,label,SIunit) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + integer(pInt), intent(in) :: nnodes,vectorSize + character(len=*), intent(in) :: SIunit,label + + integer :: hdferr + integer(HID_T) :: space_id, dset_id + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(2, int([vectorSize,Nnodes],HSIZE_T), space_id, hdferr, & + int([vectorSize,Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(group, trim(label), H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5dcreate_f') + call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addVectorDataset: h5dclose_f') + call h5sclose_f(space_id, hdferr) + +end subroutine HDF5_addVectorDataset + + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_writeScalarDataset(group,dataset,label,SIunit,dataspace_size,mpiOffset) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + character(len=*), intent(in) :: SIunit,label + integer(pInt), intent(in) :: dataspace_size, mpiOffset + real(pReal), intent(in), dimension(:) :: dataset + + integer :: hdferr, nNodes + integer(HID_T) :: dset_id, space_id, memspace, plist_id + + integer(HSIZE_T), dimension(1) :: counter + integer(HSSIZE_T), dimension(1) :: fileOffset + + nNodes = size(dataset) + if (nNodes < 1) return + + call HDF5_addScalarDataset(group,dataspace_size,label,SIunit) + call h5dopen_f(group, label, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dopen_f') + + ! Define and select hyperslabs + counter = size(dataset) ! how big i am + fileOffset = mpiOffset ! where i start to write my data + + call h5screate_simple_f(1, counter, memspace, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5screate_simple_f') + call h5dget_space_f(dset_id, space_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dget_space_f') + call h5sselect_hyperslab_f(space_id, H5S_SELECT_SET_F, fileOffset, counter, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5sselect_hyperslab_f') + + ! Create property list for collective dataset write +#ifdef PETSC + call h5pcreate_f(H5P_DATASET_XFER_F, plist_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pcreate_f') + call h5pset_dxpl_mpio_f(plist_id, H5FD_MPIO_COLLECTIVE_F, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5pset_dxpl_mpio_f') +#endif + + ! Write the dataset collectively + call h5dwrite_f(dset_id, H5T_NATIVE_DOUBLE, dataset, int([dataspace_size],HSIZE_T), hdferr, & + file_space_id = space_id, mem_space_id = memspace, xfer_prp = plist_id) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_writeScalarDataset: h5dwrite_f') + + call h5sclose_f(space_id, hdferr) + call h5sclose_f(memspace, hdferr) + call h5dclose_f(dset_id, hdferr) + call h5pclose_f(plist_id, hdferr) + +end subroutine HDF5_writeScalarDataset + + +!-------------------------------------------------------------------------------------------------- +!> @brief creates a new scalar dataset in the given group location +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_addScalarDataset(group,nnodes,label,SIunit) + use hdf5 + + implicit none + integer(HID_T), intent(in) :: group + integer(pInt), intent(in) :: nnodes + character(len=*), intent(in) :: SIunit,label + + integer :: hdferr + integer(HID_T) :: space_id, dset_id + +!-------------------------------------------------------------------------------------------------- +! create dataspace + call h5screate_simple_f(1, int([Nnodes],HSIZE_T), space_id, hdferr, & + int([Nnodes],HSIZE_T)) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5screate_simple_f') + +!-------------------------------------------------------------------------------------------------- +! create Dataset + call h5dcreate_f(group, trim(label),H5T_NATIVE_DOUBLE, space_id, dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5dcreate_f') + call HDF5_addStringAttribute(dset_id,'unit',trim(SIunit)) + +!-------------------------------------------------------------------------------------------------- +!close types, dataspaces + call h5dclose_f(dset_id, hdferr) + if (hdferr < 0) call IO_error(1_pInt,ext_msg='HDF5_addScalarDataset: h5dclose_f') + call h5sclose_f(space_id, hdferr) + +end subroutine HDF5_addScalarDataset + + + +!-------------------------------------------------------------------------------------------------- +!> @brief copies the current temp results to the actual results file +!-------------------------------------------------------------------------------------------------- +subroutine HDF5_forwardResults(time) + use hdf5 + use IO, only: & + IO_intOut + + implicit none + integer :: hdferr + real(pReal), intent(in) :: time + character(len=1024) :: myName + + currentInc = currentInc +1_pInt + write(6,*) 'forward results';flush(6) + write(myName,'(a,'//IO_intOut(currentInc)//')') 'inc',currentInc + currentIncID = HDF5_addGroup(myName) + call HDF5_setLink(myName,'current') +! call HDF5_flush(resultsFile) + call HDF5_closeGroup(currentIncID) + +end subroutine HDF5_forwardResults + +end module HDF5_Utilities diff --git a/src/IO.f90 b/src/IO.f90 index a7e77f0f4..c97dcfa9c 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -22,6 +22,7 @@ module IO public :: & IO_init, & IO_read, & + IO_recursiveRead, & IO_checkAndRewind, & IO_open_file_stat, & IO_open_jobFile_stat, & @@ -35,10 +36,6 @@ module IO IO_hybridIA, & IO_isBlank, & IO_getTag, & - IO_countSections, & - IO_countTagInPart, & - IO_spotTagInPart, & - IO_globalTagInPart, & IO_stringPos, & IO_stringValue, & IO_fixedStringValue ,& @@ -100,6 +97,7 @@ end subroutine IO_init !-------------------------------------------------------------------------------------------------- !> @brief recursively reads a line from a text file. !! Recursion is triggered by "{path/to/inputfile}" in a line +!> @details unstable and buggy !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) @@ -151,7 +149,7 @@ recursive function IO_read(fileUnit,reset) result(line) pathOn(stack) = path(1:scan(path,SEP,.true.))//input ! glue include to current file's dir endif - open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read') ! open included file + open(newunit=unitOn(stack),iostat=myStat,file=pathOn(stack),action='read',status='old',position='rewind') ! open included file if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack)) line = IO_read(fileUnit) @@ -170,6 +168,80 @@ recursive function IO_read(fileUnit,reset) result(line) end function IO_read +!-------------------------------------------------------------------------------------------------- +!> @brief recursively reads a text file. +!! Recursion is triggered by "{path/to/inputfile}" in a line +!-------------------------------------------------------------------------------------------------- +recursive function IO_recursiveRead(fileName,cnt) result(fileContent) + + implicit none + character(len=*), intent(in) :: fileName + integer(pInt), intent(in), optional :: cnt !< recursion counter + character(len=256), dimension(:), allocatable :: fileContent !< file content, separated per lines + character(len=256), dimension(:), allocatable :: includedContent + character(len=256) :: line + character(len=256), parameter :: dummy = 'https://damask.mpie.de' !< to fill up remaining array + character(len=:), allocatable :: rawData + integer(pInt) :: & + fileLength, & + fileUnit, & + startPos, endPos, & + myTotalLines, & !< # lines read from file without include statements + includedLines, & !< # lines included from other file(s) + missingLines, & !< # lines missing from current file + l,i, & + myStat + + if (merge(cnt,0_pInt,present(cnt))>10_pInt) call IO_error(106_pInt,ext_msg=trim(fileName)) + +!-------------------------------------------------------------------------------------------------- +! read data as stream + inquire(file = fileName, size=fileLength) + open(newunit=fileUnit, file=fileName, access='stream',& + status='old', position='rewind', action='read',iostat=myStat) + if(myStat /= 0_pInt) call IO_error(100_pInt,ext_msg=trim(fileName)) + allocate(character(len=fileLength)::rawData) + read(fileUnit) rawData + close(fileUnit) + +!-------------------------------------------------------------------------------------------------- +! count lines to allocate string array + myTotalLines = 0_pInt + do l=1_pInt, len(rawData) + if (rawData(l:l) == new_line('')) myTotalLines = myTotalLines+1 + enddo + allocate(fileContent(myTotalLines)) + +!-------------------------------------------------------------------------------------------------- +! split raw data at end of line and handle includes + startPos = 1_pInt + endPos = 0_pInt + + includedLines=0_pInt + l=0_pInt + do while (startPos <= len(rawData)) + l = l + 1_pInt + endPos = endPos + scan(rawData(startPos:),new_line('')) + if(endPos - startPos >256) call IO_error(107_pInt,ext_msg=trim(fileName)) + line = rawData(startPos:endPos-1_pInt) + startPos = endPos + 1_pInt + + recursion: if(scan(trim(line),'{') < scan(trim(line),'}')) then + myTotalLines = myTotalLines - 1_pInt + includedContent = IO_recursiveRead(trim(line(scan(line,'{')+1_pInt:scan(line,'}')-1_pInt)), & + merge(cnt,1_pInt,present(cnt))) ! to track recursion depth + includedLines = includedLines + size(includedContent) + missingLines = myTotalLines + includedLines - size(fileContent(1:l-1)) -size(includedContent) + fileContent = [ fileContent(1:l-1_pInt), includedContent, [(dummy,i=1,missingLines)] ] ! add content and grow array + l = l - 1_pInt + size(includedContent) + else recursion + fileContent(l) = line + endif recursion + + enddo + +end function IO_recursiveRead + !-------------------------------------------------------------------------------------------------- !> @brief checks if unit is opened for reading, if true rewinds. Otherwise stops with @@ -178,7 +250,7 @@ end function IO_read subroutine IO_checkAndRewind(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file unit + integer(pInt), intent(in) :: fileUnit !< file unit logical :: fileOpened character(len=15) :: fileRead @@ -195,19 +267,15 @@ end subroutine IO_checkAndRewind !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !! value !-------------------------------------------------------------------------------------------------- -subroutine IO_open_file(fileUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName +subroutine IO_open_file(fileUnit,path) implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: relPath !< relative path from working directory + character(len=*), intent(in) :: path !< relative path from working directory integer(pInt) :: myStat - character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//relPath - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_open_file @@ -218,19 +286,16 @@ end subroutine IO_open_file !! directory !> @details Like IO_open_file, but error is handled via return value and not via call to IO_error !-------------------------------------------------------------------------------------------------- -logical function IO_open_file_stat(fileUnit,relPath) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName +logical function IO_open_file_stat(fileUnit,path) implicit none integer(pInt), intent(in) :: fileUnit !< file unit - character(len=*), intent(in) :: relPath !< relative path from working directory + character(len=*), intent(in) :: path !< relative path from working directory integer(pInt) :: myStat - character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//relPath - open(fileUnit,status='old',iostat=myStat,file=path) + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + if (myStat /= 0_pInt) close(fileUnit) IO_open_file_stat = (myStat == 0_pInt) end function IO_open_file_stat @@ -244,7 +309,6 @@ end function IO_open_file_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_jobFile(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -254,8 +318,8 @@ subroutine IO_open_jobFile(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path) + path = trim(getSolverJobName())//'.'//ext + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_open_jobFile @@ -269,7 +333,6 @@ end subroutine IO_open_jobFile !-------------------------------------------------------------------------------------------------- logical function IO_open_jobFile_stat(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -279,8 +342,9 @@ logical function IO_open_jobFile_stat(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext - open(fileUnit,status='old',iostat=myStat,file=path) + path = trim(getSolverJobName())//'.'//ext + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') + if (myStat /= 0_pInt) close(fileUnit) IO_open_jobFile_stat = (myStat == 0_pInt) end function IO_open_JobFile_stat @@ -292,7 +356,6 @@ end function IO_open_JobFile_stat !-------------------------------------------------------------------------------------------------- subroutine IO_open_inputFile(fileUnit,modelName) use DAMASK_interface, only: & - getSolverWorkingDirectoryName,& getSolverJobName, & inputFileExtension @@ -306,23 +369,23 @@ subroutine IO_open_inputFile(fileUnit,modelName) integer(pInt) :: fileType fileType = 1_pInt ! assume .pes - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used - open(fileUnit+1,status='old',iostat=myStat,file=path) + path = trim(modelName)//inputFileExtension(fileType) ! attempt .pes, if it exists: it should be used + open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') if(myStat /= 0_pInt) then ! if .pes does not work / exist; use conventional extension, i.e.".inp" fileType = 2_pInt - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType) - open(fileUnit+1,status='old',iostat=myStat,file=path) + path = trim(modelName)//inputFileExtension(fileType) + open(fileUnit+1,status='old',iostat=myStat,file=path,action='read',position='rewind') endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension(fileType)//'_assembly' + path = trim(modelName)//inputFileExtension(fileType)//'_assembly' open(fileUnit,iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) if (.not.abaqus_assembleInputFile(fileUnit,fileUnit+1_pInt)) call IO_error(103_pInt) ! strip comments and concatenate any "include"s close(fileUnit+1_pInt) #endif #ifdef Marc4DAMASK - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension + path = trim(modelName)//inputFileExtension open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) #endif @@ -336,7 +399,6 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName, & LogFileExtension @@ -346,8 +408,8 @@ subroutine IO_open_logFile(fileUnit) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//LogFileExtension - open(fileUnit,status='old',iostat=myStat,file=path) + path = trim(getSolverJobName())//LogFileExtension + open(fileUnit,status='old',iostat=myStat,file=path,action='read',position='rewind') if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) end subroutine IO_open_logFile @@ -360,7 +422,6 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -370,7 +431,7 @@ subroutine IO_write_jobFile(fileUnit,ext) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext open(fileUnit,status='replace',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) @@ -383,7 +444,6 @@ end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -394,7 +454,7 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -414,7 +474,6 @@ end subroutine IO_write_jobRealFile !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & - getSolverWorkingDirectoryName, & getSolverJobName implicit none @@ -425,7 +484,7 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext + path = trim(getSolverJobName())//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='replace',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -444,8 +503,6 @@ end subroutine IO_write_jobIntFile !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: fileUnit !< file unit @@ -456,7 +513,7 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext + path = trim(modelName)//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) @@ -474,8 +531,6 @@ end subroutine IO_read_realFile !! located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: fileUnit !< file unit @@ -486,7 +541,7 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) integer(pInt) :: myStat character(len=1024) :: path - path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext + path = trim(modelName)//'.'//ext if (present(recMultiplier)) then open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) @@ -774,16 +829,22 @@ pure function IO_getTag(string,openChar,closeChar) character(len=*), intent(in) :: string !< string to check for tag character(len=len_trim(string)) :: IO_getTag - character(len=*), intent(in) :: openChar, & !< indicates beginning of tag - closeChar !< indicates end of tag + character, intent(in) :: openChar, & !< indicates beginning of tag + closeChar !< indicates end of tag character(len=*), parameter :: SEP=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces - integer :: left,right ! no pInt IO_getTag = '' - left = scan(string,openChar) - right = scan(string,closeChar) + + + if (openChar /= closeChar) then + left = scan(string,openChar) + right = scan(string,closeChar) + else + left = scan(string,openChar) + right = left + merge(scan(string(left+1:),openChar),0_pInt,len(string) > left) + endif if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs IO_getTag = string(left+1:right-1) @@ -791,173 +852,6 @@ pure function IO_getTag(string,openChar,closeChar) end function IO_getTag -!-------------------------------------------------------------------------------------------------- -!> @brief count number of [sections] in for given file handle -!-------------------------------------------------------------------------------------------------- -integer(pInt) function IO_countSections(fileUnit,part) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*), intent(in) :: part !< part name in which sections are counted - - character(len=65536) :: line - - line = '' - IO_countSections = 0_pInt - rewind(fileUnit) - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') & ! found [section] identifier - IO_countSections = IO_countSections + 1_pInt - enddo - -end function IO_countSections - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns array of tag counts within for at most N [sections] -!-------------------------------------------------------------------------------------------------- -function IO_countTagInPart(fileUnit,part,tag,Nsections) - - implicit none - integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for - integer(pInt), dimension(Nsections) :: IO_countTagInPart - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*),intent(in) :: part, & !< part in which tag is searched for - tag !< tag to search for - - - integer(pInt), dimension(Nsections) :: counter - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section - character(len=65536) :: line - - line = '' - counter = 0_pInt - section = 0_pInt - - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier - if (section > 0) then - chunkPos = IO_stringPos(line) - if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match - counter(section) = counter(section) + 1_pInt - endif - enddo - - IO_countTagInPart = counter - -end function IO_countTagInPart - - -!-------------------------------------------------------------------------------------------------- -!> @brief returns array of tag presence within for at most N [sections] -!-------------------------------------------------------------------------------------------------- -function IO_spotTagInPart(fileUnit,part,tag,Nsections) - - implicit none - integer(pInt), intent(in) :: Nsections !< maximum number of sections in which tag is searched for - logical, dimension(Nsections) :: IO_spotTagInPart - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*),intent(in) :: part, & !< part in which tag is searched for - tag !< tag to search for - - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section - character(len=65536) :: line - - IO_spotTagInPart = .false. ! assume to nowhere spot tag - section = 0_pInt - line = '' - - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match - IO_spotTagInPart(section) = .true. - endif - enddo - - end function IO_spotTagInPart - - -!-------------------------------------------------------------------------------------------------- -!> @brief return logical whether tag is present within before any [sections] -!-------------------------------------------------------------------------------------------------- -logical function IO_globalTagInPart(fileUnit,part,tag) - - implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - character(len=*),intent(in) :: part, & !< part in which tag is searched for - tag !< tag to search for - - integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=65536) :: line - - IO_globalTagInPart = .false. ! assume to nowhere spot tag - line ='' - - rewind(fileUnit) - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part - line = IO_read(fileUnit) - enddo - - do while (trim(line) /= IO_EOF) - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundNextPart - foundFirstSection: if (IO_getTag(line,'[',']') /= '') then - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif foundFirstSection - chunkPos = IO_stringPos(line) - match: if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) then - IO_globalTagInPart = .true. - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif match - enddo - -end function IO_globalTagInPart - - !-------------------------------------------------------------------------------------------------- !> @brief locates all space-separated chunks in given string and returns array containing number !! them and the left/right position to be used by IO_xxxVal @@ -1007,11 +901,7 @@ function IO_stringValue(string,chunkPos,myChunk,silent) logical :: warn - if (.not. present(silent)) then - warn = .false. - else - warn = silent - endif + warn = merge(silent,.false.,present(silent)) IO_stringValue = '' valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then @@ -1473,12 +1363,16 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) pure function IO_intOut(intToPrint) implicit none - character(len=19) :: N_Digits ! maximum digits for 64 bit integer - character(len=40) :: IO_intOut integer(pInt), intent(in) :: intToPrint + character(len=41) :: IO_intOut + integer(pInt) :: N_digits + character(len=19) :: width ! maximum digits for 64 bit integer + character(len=20) :: min_width ! longer for negative values - write(N_Digits, '(I19.19)') 1_pInt + int(log10(real(intToPrint)),pInt) - IO_intOut = 'I'//trim(N_Digits)//'.'//trim(N_Digits) + N_digits = 1_pInt + int(log10(real(max(abs(intToPrint),1_pInt))),pInt) + write(width, '(I19.19)') N_digits + write(min_width, '(I20.20)') N_digits + merge(1_pInt,0_pInt,intToPrint < 0_pInt) + IO_intOut = 'I'//trim(min_width)//'.'//trim(width) end function IO_intOut @@ -1534,6 +1428,10 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = '{input} recursion limit reached' case (105_pInt) msg = 'unknown output:' + case (106_pInt) + msg = 'working directory does not exist:' + case (107_pInt) + msg = 'line length exceeds limit of 256' !-------------------------------------------------------------------------------------------------- ! lattice error messages @@ -1579,6 +1477,8 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'illegal texture transformation specified' case (160_pInt) msg = 'no entries in config part' + case (161_pInt) + msg = 'config part found twice' case (165_pInt) msg = 'homogenization configuration' case (170_pInt) @@ -1676,7 +1576,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (845_pInt) msg = 'incomplete information in spectral mesh header' case (846_pInt) - msg = 'not a rotation defined for loadcase rotation' + msg = 'rotation for load case rotation ill-defined (R:RT != I)' case (847_pInt) msg = 'update of gamma operator not possible when pre-calculated' case (880_pInt) @@ -1905,8 +1805,6 @@ end function IO_verifyFloatValue !> including "include"s !-------------------------------------------------------------------------------------------------- recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) - use DAMASK_interface, only: & - getSolverWorkingDirectoryName implicit none integer(pInt), intent(in) :: unit1, & @@ -1923,7 +1821,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) chunkPos = IO_stringPos(line) if (IO_lc(IO_StringValue(line,chunkPos,1_pInt))=='*include') then - fname = trim(getSolverWorkingDirectoryName())//trim(line(9+scan(line(9:),'='):)) + fname = trim(line(9+scan(line(9:),'='):)) inquire(file=fname, exist=fexist) if (.not.(fexist)) then !$OMP CRITICAL (write2out) diff --git a/src/config.f90 b/src/config.f90 index 9d2ddde4c..4d5a76432 100644 --- a/src/config.f90 +++ b/src/config.f90 @@ -20,12 +20,17 @@ module config type, public :: tPartitionedStringList type(tPartitionedString) :: string type(tPartitionedStringList), pointer :: next => null() - contains procedure :: add => add procedure :: show => show procedure :: free => free +! currently, a finalize is needed for all shapes of tPartitionedStringList. +! with Fortran 2015, we can define one recursive elemental function +! https://software.intel.com/en-us/forums/intel-visual-fortran-compiler-for-windows/topic/543326 + final :: finalize, & + finalizeArray + procedure :: keyExists => keyExists procedure :: countKeys => countKeys @@ -37,11 +42,10 @@ module config procedure :: getInts => getInts procedure :: getStrings => getStrings + end type tPartitionedStringList - type(tPartitionedStringList), public :: emptyList - - type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & ! QUESTION: rename to config_XXX? + type(tPartitionedStringList), public, protected, allocatable, dimension(:) :: & config_phase, & config_microstructure, & config_homogenization, & @@ -76,7 +80,6 @@ module config MATERIAL_configFile = 'material.config', & !< generic name for material configuration file MATERIAL_localFileExt = 'materialConfig' !< extension of solver job name depending material configuration file - public :: & config_init, & config_deallocate @@ -92,12 +95,14 @@ subroutine config_init() compiler_version, & compiler_options #endif + use prec, only: & + pStringLen + use DAMASK_interface, only: & + getSolverJobName use IO, only: & IO_error, & - IO_open_file, & - IO_read, & IO_lc, & - IO_open_jobFile_stat, & + IO_recursiveRead, & IO_getTag, & IO_timeStamp, & IO_EOF @@ -107,12 +112,13 @@ subroutine config_init() debug_levelBasic implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt - integer(pInt) :: myDebug + integer(pInt) :: myDebug,i - character(len=65536) :: & + character(len=pStringLen) :: & line, & part + character(len=pStringLen), dimension(:), allocatable :: fileContent + logical :: fileExists write(6,'(/,a)') ' <<<+- config init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -120,39 +126,40 @@ subroutine config_init() myDebug = debug_level(debug_material) - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ...open material.config file + inquire(file=trim(getSolverJobName())//'.'//material_localFileExt,exist=fileExists) + if(fileExists) then + fileContent = IO_recursiveRead(trim(getSolverJobName())//'.'//material_localFileExt) + else + inquire(file='material.config',exist=fileExists) + if(.not. fileExists) call IO_error(100_pInt,ext_msg='material.config') + fileContent = IO_recursiveRead('material.config') + endif - rewind(fileUnit) - line = '' ! to have it initialized - do while (trim(line) /= IO_EOF) + do i = 1_pInt, size(fileContent) + line = trim(fileContent(i)) part = IO_lc(IO_getTag(line,'<','>')) - select case (trim(part)) case (trim(material_partPhase)) - call parseFile(line,phase_name,config_phase,FILEUNIT) + call parseFile(phase_name,config_phase,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Phase parsed'; flush(6) case (trim(material_partMicrostructure)) - call parseFile(line,microstructure_name,config_microstructure,FILEUNIT) + call parseFile(microstructure_name,config_microstructure,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Microstructure parsed'; flush(6) case (trim(material_partCrystallite)) - call parseFile(line,crystallite_name,config_crystallite,FILEUNIT) + call parseFile(crystallite_name,config_crystallite,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Crystallite parsed'; flush(6) case (trim(material_partHomogenization)) - call parseFile(line,homogenization_name,config_homogenization,FILEUNIT) + call parseFile(homogenization_name,config_homogenization,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Homogenization parsed'; flush(6) case (trim(material_partTexture)) - call parseFile(line,texture_name,config_texture,FILEUNIT) + call parseFile(texture_name,config_texture,line,fileContent(i+1:)) if (iand(myDebug,debug_levelBasic) /= 0_pInt) write(6,'(a)') ' Texture parsed'; flush(6) - case default - line = IO_read(fileUnit) - end select enddo @@ -173,107 +180,83 @@ end subroutine config_init !-------------------------------------------------------------------------------------------------- !> @brief parses the material.config file !-------------------------------------------------------------------------------------------------- -subroutine parseFile(line,& - sectionNames,part,fileUnit) +subroutine parseFile(sectionNames,part,line, & + fileContent) + use prec, only: & + pStringLen use IO, only: & - IO_read, & IO_error, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringValue, & - IO_stringPos, & - IO_EOF + IO_getTag implicit none - integer(pInt), intent(in) :: fileUnit - character(len=*), dimension(:), allocatable, intent(inout) :: sectionNames + character(len=64), allocatable, dimension(:), intent(out) :: sectionNames type(tPartitionedStringList), allocatable, dimension(:), intent(inout) :: part - character(len=65536),intent(out) :: line + character(len=pStringLen), intent(inout) :: line + character(len=pStringLen), dimension(:), intent(in) :: fileContent - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: s - character(len=65536) :: devNull - character(len=64) :: tag + integer(pInt), allocatable, dimension(:) :: partPosition ! position of [] tags + last line in section + integer(pInt) :: i, j logical :: echo echo = .false. - allocate(part(0)) - s = 0_pInt - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - foundNextPart: if (IO_getTag(line,'<','>') /= '') then - devNull = IO_read(fileUnit, .true.) ! reset IO_read to close any recursively included files - exit - endif foundNextPart + if (allocated(part)) call IO_error(161_pInt,ext_msg=trim(line)) + allocate(partPosition(0)) + + do i = 1_pInt, size(fileContent) + line = trim(fileContent(i)) + if (IO_getTag(line,'<','>') /= '') exit nextSection: if (IO_getTag(line,'[',']') /= '') then - s = s + 1_pInt - part = [part, emptyList] - tag = IO_getTag(line,'[',']') - GfortranBug86033: if (.not. allocated(sectionNames)) then - allocate(sectionNames(1),source=tag) - else GfortranBug86033 - sectionNames = [sectionNames,tag] - endif GfortranBug86033 + partPosition = [partPosition, i] cycle endif nextSection - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(trim(line),chunkPos,1_pInt)) ! extract key - inSection: if (s > 0_pInt) then - call part(s)%add(IO_lc(trim(line))) - else inSection - echo = (trim(tag) == '/echo/') - endif inSection + if (size(partPosition) < 1_pInt) & + echo = (trim(IO_getTag(line,'/','/')) == 'echo') .or. echo enddo - if (echo) then - do s = 1, size(sectionNames) - call part(s)%show() - end do - end if + allocate(sectionNames(size(partPosition))) + allocate(part(size(partPosition))) + + partPosition = [partPosition, i] ! needed when actually storing content + + do i = 1_pInt, size(partPosition) -1_pInt + sectionNames(i) = trim(adjustl(fileContent(partPosition(i)))) + do j = partPosition(i) + 1_pInt, partPosition(i+1) -1_pInt + call part(i)%add(trim(adjustl(fileContent(j)))) + enddo + if (echo) then + write(6,*) 'section',i, '"'//trim(sectionNames(i))//'"' + call part(i)%show() + endif + enddo end subroutine parseFile +!-------------------------------------------------------------------------------------------------- +!> @brief deallocates the linked lists that store the content of the configuration files +!-------------------------------------------------------------------------------------------------- subroutine config_deallocate(what) use IO, only: & IO_error implicit none character(len=*), intent(in) :: what - integer(pInt) :: i - select case(what) + select case(trim(what)) case('material.config/phase') - do i=1, size(config_phase) - call config_phase(i)%free - enddo deallocate(config_phase) case('material.config/microstructure') - do i=1, size(config_microstructure) - call config_microstructure(i)%free - enddo deallocate(config_microstructure) case('material.config/crystallite') - do i=1, size(config_crystallite) - call config_crystallite(i)%free - enddo deallocate(config_crystallite) case('material.config/homogenization') - do i=1, size(config_homogenization) - call config_homogenization(i)%free - enddo deallocate(config_homogenization) case('material.config/texture') - do i=1, size(config_texture) - call config_texture(i)%free - enddo deallocate(config_texture) case default @@ -284,11 +267,17 @@ subroutine config_deallocate(what) end subroutine config_deallocate +!################################################################################################## +! The folowing functions are part of the tPartitionedStringList object +!################################################################################################## + + + !-------------------------------------------------------------------------------------------------- !> @brief add element !> @details Adds a string together with the start/end position of chunks in this string. The new !! element is added at the end of the list. Empty strings are not added. All strings are converted -!! to lower case +!! to lower case. The data is not stored in the new element but in the current. !-------------------------------------------------------------------------------------------------- subroutine add(this,string) use IO, only: & @@ -299,19 +288,18 @@ subroutine add(this,string) implicit none class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: string - type(tPartitionedStringList), pointer :: new, item + type(tPartitionedStringList), pointer :: new, temp if (IO_isBlank(string)) return allocate(new) - new%string%val = IO_lc (trim(string)) - new%string%pos = IO_stringPos(trim(string)) - - item => this - do while (associated(item%next)) - item => item%next + temp => this + do while (associated(temp%next)) + temp => temp%next enddo - item%next => new + temp%string%val = IO_lc (trim(string)) + temp%string%pos = IO_stringPos(trim(string)) + temp%next => new end subroutine add @@ -323,12 +311,12 @@ end subroutine add subroutine show(this) implicit none - class(tPartitionedStringList) :: this - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + type(tPartitionedStringList), pointer :: item - item => this%next - do while (associated(item)) - write(6,'(a)') trim(item%string%val) + item => this + do while (associated(item%next)) + write(6,'(a)') ' '//trim(item%string%val) item => item%next end do @@ -336,28 +324,55 @@ end subroutine show !-------------------------------------------------------------------------------------------------- -!> @brief cleans entire list -!> @details list head is remains alive +!> @brief empties list and frees associated memory +!> @details explicit interface to reset list. Triggers final statement (and following chain reaction) !-------------------------------------------------------------------------------------------------- subroutine free(this) implicit none - class(tPartitionedStringList), target, intent(in) :: this - type(tPartitionedStringList), pointer :: new, item + class(tPartitionedStringList), intent(inout) :: this - if (.not. associated(this%next)) return - - item => this%next - do while (associated(item%next)) - new => item - deallocate(item) - item => new%next - enddo - deallocate(item) + if(associated(this%next)) deallocate(this%next) end subroutine free +!-------------------------------------------------------------------------------------------------- +!> @brief empties list and frees associated memory +!> @details called when variable goes out of scope. Triggers chain reaction for list +!-------------------------------------------------------------------------------------------------- +recursive subroutine finalize(this) + + implicit none + type(tPartitionedStringList), intent(inout) :: this + + if(associated(this%next)) deallocate(this%next) + +end subroutine finalize + + +!-------------------------------------------------------------------------------------------------- +!> @brief cleans entire array of linke lists +!> @details called when variable goes out of scope and deallocates the list at each array entry +!-------------------------------------------------------------------------------------------------- +subroutine finalizeArray(this) + + implicit none + integer :: i + type(tPartitionedStringList), intent(inout), dimension(:) :: this + type(tPartitionedStringList), pointer :: temp ! bug in Gfortran? + + do i=1, size(this) + if (associated(this(i)%next)) then + temp => this(i)%next + !deallocate(this(i)) !internal compiler error: in gfc_build_final_call, at fortran/trans.c:975 + deallocate(temp) + endif + enddo + +end subroutine finalizeArray + + !-------------------------------------------------------------------------------------------------- !> @brief reports wether a given key (string value at first position) exists in the list !-------------------------------------------------------------------------------------------------- @@ -366,14 +381,14 @@ logical function keyExists(this,key) IO_stringValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item keyExists = .false. - item => this%next - do while (associated(item) .and. .not. keyExists) + item => this + do while (associated(item%next) .and. .not. keyExists) keyExists = trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key) item => item%next end do @@ -391,14 +406,14 @@ integer(pInt) function countKeys(this,key) implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - type(tPartitionedStringList), pointer :: item + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + type(tPartitionedStringList), pointer :: item countKeys = 0_pInt - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) & countKeys = countKeys + 1_pInt item => item%next @@ -419,17 +434,17 @@ real(pReal) function getFloat(this,key,defaultVal) IO_FloatValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - real(pReal), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + real(pReal), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found found = present(defaultVal) if (found) getFloat = defaultVal - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -455,17 +470,17 @@ integer(pInt) function getInt(this,key,defaultVal) IO_IntValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - integer(pInt), intent(in), optional :: defaultVal - type(tPartitionedStringList), pointer :: item - logical :: found + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + integer(pInt), intent(in), optional :: defaultVal + type(tPartitionedStringList), pointer :: item + logical :: found found = present(defaultVal) if (found) getInt = defaultVal - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -491,13 +506,13 @@ character(len=65536) function getString(this,key,defaultVal,raw) IO_stringValue implicit none - class(tPartitionedStringList), intent(in) :: this - character(len=*), intent(in) :: key - character(len=65536), intent(in), optional :: defaultVal - logical, intent(in), optional :: raw - type(tPartitionedStringList), pointer :: item - logical :: found, & - whole + class(tPartitionedStringList), target, intent(in) :: this + character(len=*), intent(in) :: key + character(len=65536), intent(in), optional :: defaultVal + logical, intent(in), optional :: raw + type(tPartitionedStringList), pointer :: item + logical :: found, & + whole whole = merge(raw,.false.,present(raw)) ! whole string or white space splitting found = present(defaultVal) @@ -506,8 +521,8 @@ character(len=65536) function getString(this,key,defaultVal,raw) if (len_trim(getString) /= len_trim(defaultVal)) call IO_error(0_pInt,ext_msg='getString') endif - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (item%string%pos(1) < 2_pInt) call IO_error(143_pInt,ext_msg=key) @@ -539,7 +554,7 @@ function getFloats(this,key,defaultVal,requiredShape) implicit none real(pReal), dimension(:), allocatable :: getFloats - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key real(pReal), dimension(:), intent(in), optional :: defaultVal integer(pInt), dimension(:), intent(in), optional :: requiredShape @@ -553,8 +568,8 @@ function getFloats(this,key,defaultVal,requiredShape) allocate(getFloats(0)) - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (.not. cumulative) getFloats = [real(pReal)::] @@ -586,7 +601,7 @@ function getInts(this,key,defaultVal,requiredShape) implicit none integer(pInt), dimension(:), allocatable :: getInts - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key integer(pInt), dimension(:), intent(in), optional :: defaultVal, & requiredShape @@ -600,8 +615,8 @@ function getInts(this,key,defaultVal,requiredShape) allocate(getInts(0)) - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (.not. cumulative) getInts = [integer(pInt)::] @@ -633,7 +648,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw) implicit none character(len=65536),dimension(:), allocatable :: getStrings - class(tPartitionedStringList), intent(in) :: this + class(tPartitionedStringList), target, intent(in) :: this character(len=*), intent(in) :: key character(len=65536),dimension(:), intent(in), optional :: defaultVal integer(pInt), dimension(:), intent(in), optional :: requiredShape @@ -649,8 +664,8 @@ function getStrings(this,key,defaultVal,requiredShape,raw) whole = merge(raw,.false.,present(raw)) found = .false. - item => this%next - do while (associated(item)) + item => this + do while (associated(item%next)) if (trim(IO_stringValue(item%string%val,item%string%pos,1)) == trim(key)) then found = .true. if (allocated(getStrings) .and. .not. cumulative) deallocate(getStrings) @@ -670,6 +685,7 @@ function getStrings(this,key,defaultVal,requiredShape,raw) endif else notAllocated if (whole) then + str = item%string%val(item%string%pos(4):) getStrings = [getStrings,str] else do i=2_pInt,item%string%pos(1) diff --git a/src/constitutive.f90 b/src/constitutive.f90 index 88d75dec1..43207c65c 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -58,14 +58,15 @@ subroutine constitutive_init() IO_write_jobIntFile, & IO_timeStamp use config, only: & - config_deallocate + config_phase use mesh, only: & FE_geomtype use config, only: & material_Nphase, & material_localFileExt, & phase_name, & - material_configFile + material_configFile, & + config_deallocate use material, only: & material_phase, & phase_plasticity, & @@ -138,7 +139,7 @@ subroutine constitutive_init() use kinematics_hydrogen_strain implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt + integer(pInt), parameter :: FILEUNIT = 204_pInt integer(pInt) :: & o, & !< counter in output loop ph, & !< counter in phase loop @@ -160,7 +161,7 @@ subroutine constitutive_init() ! parse plasticities from config file if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init - if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) + if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init if (any(phase_plasticity == PLASTICITY_KINEHARDENING_ID)) call plastic_kinehardening_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOTWIN_ID)) call plastic_dislotwin_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_DISLOUCLA_ID)) call plastic_disloucla_init(FILEUNIT) @@ -864,19 +865,11 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra FpArray !< plastic deformation gradient real(pReal), intent(in), dimension(6) :: & Tstar_v !< 2nd Piola Kirchhoff stress tensor (Mandel) - integer(pLongInt) :: & - tick = 0_pLongInt, & - tock = 0_pLongInt, & - tickrate, & - maxticks integer(pInt) :: & ho, & !< homogenization tme, & !< thermal member position s !< counter in source loop - if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & - call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) - ho = material_homog( ip,el) tme = thermalMapping(ho)%p(ip,el) @@ -957,13 +950,6 @@ subroutine constitutive_collectDeltaState(Tstar_v, Fe, ipc, ip, el) Fe !< elastic deformation gradient integer(pInt) :: & s !< counter in source loop - integer(pLongInt) :: & - tick, tock, & - tickrate, & - maxticks - - if (iand(debug_level(debug_constitutive), debug_levelBasic) /= 0_pInt) & - call system_clock(count=tick,count_rate=tickrate,count_max=maxticks) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_KINEHARDENING_ID) plasticityType diff --git a/src/crystallite.f90 b/src/crystallite.f90 index aea4fb993..66ee395aa 100644 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -114,6 +114,7 @@ module crystallite end enum integer(kind(undefined_ID)),dimension(:,:), allocatable, private :: & crystallite_outputID !< ID of each post result output + procedure(), pointer :: integrateState public :: & crystallite_init, & @@ -122,6 +123,7 @@ module crystallite crystallite_push33ToRef, & crystallite_postResults private :: & + integrateState, & crystallite_integrateStateFPI, & crystallite_integrateStateEuler, & crystallite_integrateStateAdaptiveEuler, & @@ -149,6 +151,7 @@ subroutine crystallite_init debug_crystallite, & debug_levelBasic use numerics, only: & + numerics_integrator, & worldrank, & usePingPong use math, only: & @@ -172,12 +175,13 @@ subroutine crystallite_init IO_error use material use config, only: & + config_deallocate, & config_crystallite, & crystallite_name, & - config_deallocate + material_Nphase use constitutive, only: & constitutive_initialFi, & - constitutive_microstructure ! derived (shortcut) quantities of given state + constitutive_microstructure ! derived (shortcut) quantities of given state implicit none @@ -187,7 +191,8 @@ subroutine crystallite_init i, & !< counter in integration point loop e, & !< counter in element loop o = 0_pInt, & !< counter in output loop - r, & !< counter in crystallite loop + r, & + ph, & !< counter in crystallite loop cMax, & !< maximum number of integration point components iMax, & !< maximum number of integration points eMax, & !< maximum number of elements @@ -269,6 +274,20 @@ subroutine crystallite_init allocate(crystallite_sizePostResult(maxval(crystallite_Noutput), & size(config_crystallite)), source=0_pInt) + select case(numerics_integrator(1)) + case(1_pInt) + integrateState => crystallite_integrateStateFPI + case(2_pInt) + integrateState => crystallite_integrateStateEuler + case(3_pInt) + integrateState => crystallite_integrateStateAdaptiveEuler + case(4_pInt) + integrateState => crystallite_integrateStateRK4 + case(5_pInt) + integrateState => crystallite_integrateStateRKCK45 + end select + + do c = 1_pInt, size(config_crystallite) #if defined(__GFORTRAN__) @@ -421,6 +440,19 @@ subroutine crystallite_init enddo !$OMP END PARALLEL DO + do ph = 1_pInt,material_Nphase +!-------------------------------------------------------------------------------------------------- +! propagate dependent states to materialpoint and boundary value problem level + plasticState(ph)%partionedState0(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) & + = plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) + plasticState(ph)%state0 (plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) & + = plasticState(ph)%state(plasticState(ph)%offsetDeltaState+plasticState(ph)%sizeDeltaState: & + plasticState(ph)%sizeState,:) + enddo + call crystallite_stressAndItsTangent(.true.) ! request elastic answers crystallite_fallbackdPdF = crystallite_dPdF ! use initial elastic stiffness as fallback @@ -494,9 +526,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) subStepMinCryst, & subStepSizeCryst, & stepIncreaseCryst, & - nCryst, & - numerics_integrator, & - numerics_integrationMode, & numerics_timeSyncing use debug, only: & debug_level, & @@ -615,6 +644,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (crystallite_requested(c,i,e)) then plasticState (phaseAt(c,i,e))%subState0( :,phasememberAt(c,i,e)) = & plasticState (phaseAt(c,i,e))%partionedState0(:,phasememberAt(c,i,e)) + do mySource = 1_pInt, phase_Nsources(phaseAt(c,i,e)) sourceState(phaseAt(c,i,e))%p(mySource)%subState0( :,phasememberAt(c,i,e)) = & sourceState(phaseAt(c,i,e))%p(mySource)%partionedState0(:,phasememberAt(c,i,e)) @@ -648,7 +678,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) endif singleRun NiterationCrystallite = 0_pInt - numerics_integrationMode = 1_pInt cutbackLooping: do while (any(crystallite_todo(:,startIP:endIP,FEsolving_execELem(1):FEsolving_execElem(2)))) if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & @@ -991,7 +1020,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) timeSyncing2: if(numerics_timeSyncing) then if (any(.not. crystallite_localPlasticity .and. .not. crystallite_todo .and. .not. crystallite_converged & - .and. crystallite_subStep <= subStepMinCryst)) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ... + .and. crystallite_subStep <= subStepMinCryst)) then ! no way of rescuing a nonlocal ip that violated the lower time step limit, ... if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then elementLooping4: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNcomponents = homogenization_Ngrains(mesh_element(3,e)) @@ -1005,7 +1034,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) enddo elementLooping4 endif where(.not. crystallite_localPlasticity) - crystallite_todo = .false. ! ... so let all nonlocal ips die peacefully + crystallite_todo = .false. ! ... so let all nonlocal ips die peacefully crystallite_subStep = 0.0_pReal endwhere endif @@ -1026,25 +1055,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! --- integrate --- requires fully defined state array (basic + dependent state) - if (any(crystallite_todo)) then - if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) then - write(6,'(/,a,i3)') '<< CRYST >> using state integrator ',numerics_integrator(numerics_integrationMode) - flush(6) - endif - select case(numerics_integrator(numerics_integrationMode)) - case(1_pInt) - call crystallite_integrateStateFPI() - case(2_pInt) - call crystallite_integrateStateEuler() - case(3_pInt) - call crystallite_integrateStateAdaptiveEuler() - case(4_pInt) - call crystallite_integrateStateRK4() - case(5_pInt) - call crystallite_integrateStateRKCK45() - end select - endif - + if (any(crystallite_todo)) call integrateState() where(.not. crystallite_converged .and. crystallite_subStep > subStepMinCryst) & ! do not try non-converged & fully cutbacked any further crystallite_todo = .true. @@ -1057,9 +1068,9 @@ subroutine crystallite_stressAndItsTangent(updateJaco) elementLooping5: do e = FEsolving_execElem(1),FEsolving_execElem(2) myNcomponents = homogenization_Ngrains(mesh_element(3,e)) - do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed + do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) ! iterate over IPs of this element to be processed do c = 1,myNcomponents - if (.not. crystallite_converged(c,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) + if (.not. crystallite_converged(c,i,e)) then ! respond fully elastically (might be not required due to becoming terminally ill anyway) if(iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> no convergence: respond fully elastic at el (elFE) ip ipc ', & e,'(',mesh_element(1,e),')',i,c @@ -1215,8 +1226,6 @@ end subroutine crystallite_stressAndItsTangent subroutine crystallite_integrateStateRK4() use, intrinsic :: & IEEE_arithmetic - use numerics, only: & - numerics_integrationMode use debug, only: & #ifdef DEBUG debug_e, & @@ -1517,8 +1526,7 @@ subroutine crystallite_integrateStateRKCK45() debug_levelExtensive, & debug_levelSelective use numerics, only: & - rTol_crystalliteState, & - numerics_integrationMode + rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -2013,8 +2021,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() debug_levelExtensive, & debug_levelSelective use numerics, only: & - rTol_crystalliteState, & - numerics_integrationMode + rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & FEsolving_execIP @@ -2082,7 +2089,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() sourceStateResiduum = 0.0_pReal relSourceStateResiduum = 0.0_pReal - integrationMode: if (numerics_integrationMode == 1_pInt) then !$OMP PARALLEL ! --- DOT STATE (EULER INTEGRATION) --- @@ -2182,7 +2188,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL - endif integrationMode ! --- STRESS INTEGRATION (EULER INTEGRATION) --- @@ -2202,9 +2207,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() enddo; enddo; enddo !$OMP END PARALLEL DO - - if (numerics_integrationMode == 1_pInt) then - !$OMP PARALLEL ! --- DOT STATE (HEUN METHOD) --- @@ -2323,17 +2325,6 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP ENDDO !$OMP END PARALLEL - elseif (numerics_integrationMode > 1) then ! stiffness calculation - - !$OMP PARALLEL DO - do e = eIter(1),eIter(2); do i = iIter(1,e),iIter(2,e); do g = gIter(1,e),gIter(2,e) ! iterate over elements, ips and grains - crystallite_converged(g,i,e) = crystallite_todo(g,i,e) .or. crystallite_converged(g,i,e) ! ... converged per definitionem - enddo; enddo; enddo - !$OMP END PARALLEL DO - - endif - - ! --- NONLOCAL CONVERGENCE CHECK --- @@ -2364,7 +2355,6 @@ subroutine crystallite_integrateStateEuler() debug_levelExtensive, & debug_levelSelective use numerics, only: & - numerics_integrationMode, & numerics_timeSyncing use FEsolving, only: & FEsolving_execElem, & @@ -2411,7 +2401,6 @@ eIter = FEsolving_execElem(1:2) singleRun = (eIter(1) == eIter(2) .and. iIter(1,eIter(1)) == iIter(2,eIter(2))) - if (numerics_integrationMode == 1_pInt) then !$OMP PARALLEL ! --- DOT STATE --- @@ -2516,7 +2505,6 @@ eIter = FEsolving_execElem(1:2) enddo; enddo; enddo !$OMP ENDDO !$OMP END PARALLEL - endif !$OMP PARALLEL @@ -2581,7 +2569,6 @@ subroutine crystallite_integrateStateFPI() debug_levelSelective use numerics, only: & nState, & - numerics_integrationMode, & rTol_crystalliteState use FEsolving, only: & FEsolving_execElem, & @@ -3156,7 +3143,6 @@ logical function crystallite_integrateStress(& aTol_crystalliteStress, & rTol_crystalliteStress, & iJacoLpresiduum, & - numerics_integrationMode, & subStepSizeLp, & subStepSizeLi use debug, only: debug_level, & diff --git a/src/debug.f90 b/src/debug.f90 index ea2b659a1..6debf84c2 100644 --- a/src/debug.f90 +++ b/src/debug.f90 @@ -102,13 +102,16 @@ subroutine debug_init IO_EOF implicit none - integer(pInt), parameter :: FILEUNIT = 300_pInt + integer(pInt), parameter :: FILEUNIT = 330_pInt integer(pInt) :: i, what integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: tag, line write(6,'(/,a)') ' <<<+- debug init -+>>>' +#ifdef DEBUG + write(6,'(a)') achar(27)//'[31m <<<+- DEBUG version -+>>>'//achar(27)//'[0m' +#endif write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -283,11 +286,8 @@ end subroutine debug_reset subroutine debug_info implicit none - character(len=1) :: exceed - !$OMP CRITICAL (write2out) - debugOutputCPFEM: if (iand(debug_level(debug_CPFEM),debug_LEVELBASIC) /= 0 & .and. any(debug_stressMinLocation /= 0_pInt) & .and. any(debug_stressMaxLocation /= 0_pInt) ) then diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 75330e86c..77d301400 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -6,9 +6,6 @@ !-------------------------------------------------------------------------------------------------- module homogenization use prec, only: & -#ifdef FEM - tOutputData, & -#endif pInt, & pReal @@ -22,16 +19,8 @@ module homogenization materialpoint_P !< first P--K stress of IP real(pReal), dimension(:,:,:,:,:,:), allocatable, public :: & materialpoint_dPdF !< tangent of first P--K stress at IP -#ifdef FEM - type(tOutputData), dimension(:), allocatable, public :: & - homogOutput - type(tOutputData), dimension(:,:), allocatable, public :: & - crystalliteOutput, & - phaseOutput -#else real(pReal), dimension(:,:,:), allocatable, public :: & materialpoint_results !< results array of material point -#endif integer(pInt), public, protected :: & materialpoint_sizeResults, & homogenization_maxSizePostResults, & @@ -90,20 +79,15 @@ subroutine homogenization_init mesh_element, & FE_Nips, & FE_geomtype -#ifdef FEM - use crystallite, only: & - crystallite_sizePostResults -#else use constitutive, only: & constitutive_plasticity_maxSizePostResults, & constitutive_source_maxSizePostResults use crystallite, only: & crystallite_maxSizePostResults -#endif use config, only: & - config_deallocate, & material_configFile, & material_localFileExt, & + config_deallocate, & config_homogenization, & homogenization_name use material @@ -411,33 +395,6 @@ subroutine homogenization_init hydrogenflux_maxSizePostResults = max(hydrogenflux_maxSizePostResults ,hydrogenfluxState(p)%sizePostResults) enddo -#ifdef FEM - allocate(homogOutput (material_Nhomogenization )) - allocate(crystalliteOutput(material_Ncrystallite, homogenization_maxNgrains)) - allocate(phaseOutput (material_Nphase, homogenization_maxNgrains)) - do p = 1, material_Nhomogenization - homogOutput(p)%sizeResults = homogState (p)%sizePostResults + & - thermalState (p)%sizePostResults + & - damageState (p)%sizePostResults + & - vacancyfluxState (p)%sizePostResults + & - porosityState (p)%sizePostResults + & - hydrogenfluxState(p)%sizePostResults - homogOutput(p)%sizeIpCells = count(material_homog==p) - allocate(homogOutput(p)%output(homogOutput(p)%sizeResults,homogOutput(p)%sizeIpCells)) - enddo - do p = 1, material_Ncrystallite; do e = 1, homogenization_maxNgrains - crystalliteOutput(p,e)%sizeResults = crystallite_sizePostResults(p) - crystalliteOutput(p,e)%sizeIpCells = count(microstructure_crystallite(mesh_element(4,:)) == p .and. & - homogenization_Ngrains (mesh_element(3,:)) >= e)*mesh_maxNips - allocate(crystalliteOutput(p,e)%output(crystalliteOutput(p,e)%sizeResults,crystalliteOutput(p,e)%sizeIpCells)) - enddo; enddo - do p = 1, material_Nphase; do e = 1, homogenization_maxNgrains - phaseOutput(p,e)%sizeResults = plasticState (p)%sizePostResults + & - sum(sourceState (p)%p(:)%sizePostResults) - phaseOutput(p,e)%sizeIpCells = count(material_phase(e,:,:) == p) - allocate(phaseOutput(p,e)%output(phaseOutput(p,e)%sizeResults,phaseOutput(p,e)%sizeIpCells)) - enddo; enddo -#else materialpoint_sizeResults = 1 & ! grain count + 1 + homogenization_maxSizePostResults & ! homogSize & homogResult + thermal_maxSizePostResults & @@ -449,7 +406,6 @@ subroutine homogenization_init + 1 + constitutive_plasticity_maxSizePostResults & ! constitutive size & constitutive results + constitutive_source_maxSizePostResults) allocate(materialpoint_results(materialpoint_sizeResults,mesh_maxNips,mesh_NcpElems)) -#endif write(6,'(/,a)') ' <<<+- homogenization init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() @@ -473,9 +429,6 @@ subroutine homogenization_init write(6,'(a32,1x,7(i8,1x))') 'materialpoint_requested: ', shape(materialpoint_requested) write(6,'(a32,1x,7(i8,1x))') 'materialpoint_converged: ', shape(materialpoint_converged) write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_doneAndHappy: ', shape(materialpoint_doneAndHappy) -#ifndef FEM - write(6,'(a32,1x,7(i8,1x),/)') 'materialpoint_results: ', shape(materialpoint_results) -#endif write(6,'(a32,1x,7(i8,1x))') 'maxSizePostResults: ', homogenization_maxSizePostResults endif flush(6) @@ -494,7 +447,6 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) subStepMinHomog, & subStepSizeHomog, & stepIncreaseHomog, & - nHomog, & nMPstate use math, only: & math_transpose33 @@ -905,33 +857,18 @@ subroutine materialpoint_postResults mesh_element use material, only: & mappingHomogenization, & -#ifdef FEM - phaseAt, phasememberAt, & - homogenization_maxNgrains, & - material_Ncrystallite, & - material_Nphase, & -#else homogState, & thermalState, & damageState, & vacancyfluxState, & porosityState, & hydrogenfluxState, & -#endif plasticState, & sourceState, & material_phase, & homogenization_Ngrains, & microstructure_crystallite -#ifdef FEM - use constitutive, only: & - constitutive_plasticity_maxSizePostResults, & - constitutive_source_maxSizePostResults -#endif use crystallite, only: & -#ifdef FEM - crystallite_maxSizePostResults, & -#endif crystallite_sizePostResults, & crystallite_postResults @@ -944,55 +881,6 @@ subroutine materialpoint_postResults g, & !< grain number i, & !< integration point number e !< element number -#ifdef FEM - integer(pInt) :: & - myHomog, & - myPhase, & - crystalliteCtr(material_Ncrystallite, homogenization_maxNgrains), & - phaseCtr (material_Nphase, homogenization_maxNgrains) - real(pReal), dimension(1+crystallite_maxSizePostResults + & - 1+constitutive_plasticity_maxSizePostResults + & - constitutive_source_maxSizePostResults) :: & - crystalliteResults - - - - crystalliteCtr = 0_pInt; phaseCtr = 0_pInt - elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) - myNgrains = homogenization_Ngrains(mesh_element(3,e)) - myCrystallite = microstructure_crystallite(mesh_element(4,e)) - IpLooping: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) - myHomog = mappingHomogenization(2,i,e) - thePos = mappingHomogenization(1,i,e) - homogOutput(myHomog)%output(1: & - homogOutput(myHomog)%sizeResults, & - thePos) = homogenization_postResults(i,e) - - grainLooping :do g = 1,myNgrains - myPhase = phaseAt(g,i,e) - crystalliteResults(1:1+crystallite_sizePostResults(myCrystallite) + & - 1+plasticState(myPhase)%sizePostResults + & - sum(sourceState(myPhase)%p(:)%sizePostResults)) = crystallite_postResults(g,i,e) - if (microstructure_crystallite(mesh_element(4,e)) == myCrystallite .and. & - homogenization_Ngrains (mesh_element(3,e)) >= g) then - crystalliteCtr(myCrystallite,g) = crystalliteCtr(myCrystallite,g) + 1_pInt - crystalliteOutput(myCrystallite,g)% & - output(1:crystalliteOutput(myCrystallite,g)%sizeResults,crystalliteCtr(myCrystallite,g)) = & - crystalliteResults(2:1+crystalliteOutput(myCrystallite,g)%sizeResults) - endif - if (material_phase(g,i,e) == myPhase) then - phaseCtr(myPhase,g) = phaseCtr(myPhase,g) + 1_pInt - phaseOutput(myPhase,g)% & - output(1:phaseOutput(myPhase,g)%sizeResults,phaseCtr(myPhase,g)) = & - crystalliteResults(3 + crystalliteOutput(myCrystallite,g)%sizeResults: & - 1 + crystalliteOutput(myCrystallite,g)%sizeResults + & - 1 + plasticState (myphase)%sizePostResults + & - sum(sourceState(myphase)%p(:)%sizePostResults)) - endif - enddo grainLooping - enddo IpLooping - enddo elementLooping -#else !$OMP PARALLEL DO PRIVATE(myNgrains,myCrystallite,thePos,theSize) elementLooping: do e = FEsolving_execElem(1),FEsolving_execElem(2) @@ -1028,7 +916,6 @@ subroutine materialpoint_postResults enddo IpLooping enddo elementLooping !$OMP END PARALLEL DO -#endif end subroutine materialpoint_postResults diff --git a/src/lattice.f90 b/src/lattice.f90 index 386001c76..ffe1c239d 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -16,7 +16,7 @@ module lattice integer(pInt), parameter, public :: & LATTICE_maxNslipFamily = 13_pInt, & !< max # of slip system families over lattice structures LATTICE_maxNtwinFamily = 4_pInt, & !< max # of twin system families over lattice structures - LATTICE_maxNtransFamily = 2_pInt, & !< max # of transformation system families over lattice structures + LATTICE_maxNtransFamily = 1_pInt, & !< max # of transformation system families over lattice structures LATTICE_maxNcleavageFamily = 3_pInt !< max # of transformation system families over lattice structures integer(pInt), allocatable, dimension(:,:), protected, public :: & @@ -82,17 +82,17 @@ module lattice LATTICE_fcc_NtwinSystem = int([12, 0, 0, 0],pInt) !< # of twin systems per family for fcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_fcc_NtransSystem = int([12, 0],pInt) !< # of transformation systems per family for fcc + LATTICE_fcc_NtransSystem = int([12],pInt) !< # of transformation systems per family for fcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & LATTICE_fcc_NcleavageSystem = int([3, 4, 0],pInt) !< # of cleavage systems per family for fcc integer(pInt), parameter, private :: & - LATTICE_fcc_Nslip = 12_pInt, & !sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc - LATTICE_fcc_Ntwin = 12_pInt, & !sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc + LATTICE_fcc_Nslip = sum(lattice_fcc_NslipSystem), & !< total # of slip systems for fcc + LATTICE_fcc_Ntwin = sum(lattice_fcc_NtwinSystem), & !< total # of twin systems for fcc LATTICE_fcc_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for fcc - LATTICE_fcc_Ntrans = 12_pInt, & !sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc - LATTICE_fcc_Ncleavage = 7_pInt !sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc + LATTICE_fcc_Ntrans = sum(lattice_fcc_NtransSystem), & !< total # of transformation systems for fcc + LATTICE_fcc_Ncleavage = sum(lattice_fcc_NcleavageSystem) !< total # of cleavage systems for fcc real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& @@ -111,6 +111,9 @@ module lattice -1,-1, 0, -1, 1,-1 & ! D6 ],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Nslip]) !< Slip system <110>{111} directions. Sorted according to Eisenlohr & Hantcherli + character(len=*), dimension(1), parameter, public :: LATTICE_FCC_SLIPFAMILY_NAME = & + ['<0 1 -1>{1 1 1}'] + real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: & LATTICE_fcc_systemTwin = reshape(real( [& -2, 1, 1, 1, 1, 1, & @@ -127,6 +130,9 @@ module lattice -1, 1, 2, -1, 1,-1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_fcc_Ntwin]) !< Twin system <112>{111} directions. Sorted according to Eisenlohr & Hantcherli + character(len=*), dimension(1), parameter, public :: LATTICE_FCC_TWINFAMILY_NAME = & + ['<-2 1 1>{1 1 1}'] + real(pReal), dimension(3+3,LATTICE_fcc_Ntrans), parameter, private :: & LATTICE_fccTohex_systemTrans = reshape(real( [& -2, 1, 1, 1, 1, 1, & @@ -365,17 +371,17 @@ module lattice LATTICE_bcc_NtwinSystem = int([ 12, 0, 0, 0], pInt) !< # of twin systems per family for bcc integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bcc_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bcc + LATTICE_bcc_NtransSystem = int([0],pInt) !< # of transformation systems per family for bcc integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bcc_NcleavageSystem = int([3,6,0],pInt) !< # of cleavage systems per family for bcc + LATTICE_bcc_NcleavageSystem = int([3, 6, 0],pInt) !< # of cleavage systems per family for bcc integer(pInt), parameter, private :: & - LATTICE_bcc_Nslip = 24_pInt, & !sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc - LATTICE_bcc_Ntwin = 12_pInt, & !sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc + LATTICE_bcc_Nslip = sum(lattice_bcc_NslipSystem), & !< total # of slip systems for bcc + LATTICE_bcc_Ntwin = sum(lattice_bcc_NtwinSystem), & !< total # of twin systems for bcc LATTICE_bcc_NnonSchmid = 6_pInt, & !< total # of non-Schmid contributions for bcc (A. Koester, A. Ma, A. Hartmaier 2012) - LATTICE_bcc_Ntrans = 0_pInt, & !sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc - LATTICE_bcc_Ncleavage = 9_pInt !sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc + LATTICE_bcc_Ntrans = sum(lattice_bcc_NtransSystem), & !< total # of transformation systems for bcc + LATTICE_bcc_Ncleavage = sum(lattice_bcc_NcleavageSystem) !< total # of cleavage systems for bcc real(pReal), dimension(3+3,LATTICE_bcc_Nslip), parameter, private :: & LATTICE_bcc_systemSlip = reshape(real([& @@ -433,6 +439,10 @@ module lattice ! 1,-1, 1, 3, 2,-1 & ],pReal),[ 3_pInt + 3_pInt ,LATTICE_bcc_Nslip]) + character(len=*), dimension(2), parameter, public :: LATTICE_BCC_SLIPFAMILY_NAME = & + ['<1 -1 1>{0 1 1}', & + '<1 -1 1>{2 1 1}'] + real(pReal), dimension(3+3,LATTICE_bcc_Ntwin), parameter, private :: & LATTICE_bcc_systemTwin = reshape(real([& ! Twin system <111>{112} @@ -450,6 +460,9 @@ module lattice 1, 1, 1, 1, 1,-2 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_bcc_Ntwin]) + character(len=*), dimension(1), parameter, public :: LATTICE_BCC_TWINFAMILY_NAME = & + ['<1 1 1>{2 1 1}'] + real(pReal), dimension(LATTICE_bcc_Ntwin), parameter, private :: & LATTICE_bcc_shearTwin = 0.5_pReal*sqrt(2.0_pReal) @@ -556,23 +569,23 @@ module lattice !-------------------------------------------------------------------------------------------------- ! hexagonal integer(pInt), dimension(LATTICE_maxNslipFamily), parameter, public :: & - lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex + lattice_hex_NslipSystem = int([ 3, 3, 3, 6, 12, 6, 0, 0, 0, 0, 0, 0, 0],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNtwinFamily), parameter, public :: & lattice_hex_NtwinSystem = int([ 6, 6, 6, 6],pInt) !< # of slip systems per family for hex integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_hex_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for hex + LATTICE_hex_NtransSystem = int([0],pInt) !< # of transformation systems per family for hex integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_hex_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for hex + LATTICE_hex_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for hex integer(pInt), parameter, private :: & - LATTICE_hex_Nslip = 33_pInt, & !sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex - LATTICE_hex_Ntwin = 24_pInt, & !sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex + LATTICE_hex_Nslip = sum(lattice_hex_NslipSystem), & !< total # of slip systems for hex + LATTICE_hex_Ntwin = sum(lattice_hex_NtwinSystem), & !< total # of twin systems for hex LATTICE_hex_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for hex - LATTICE_hex_Ntrans = 0_pInt, & !sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex - LATTICE_hex_Ncleavage = 3_pInt !sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex + LATTICE_hex_Ntrans = sum(lattice_hex_NtransSystem), & !< total # of transformation systems for hex + LATTICE_hex_Ncleavage = sum(lattice_hex_NcleavageSystem) !< total # of cleavage systems for hex real(pReal), dimension(4+4,LATTICE_hex_Nslip), parameter, private :: & LATTICE_hex_systemSlip = reshape(real([& @@ -618,6 +631,14 @@ module lattice 1, 1, -2, 3, -1, -1, 2, 2 & ],pReal),[ 4_pInt + 4_pInt,LATTICE_hex_Nslip]) !< slip systems for hex sorted by A. Alankar & P. Eisenlohr + character(len=*), dimension(6), parameter, public :: LATTICE_HEX_SLIPFAMILY_NAME = & + ['<1 1 . 1>{0 0 . 1} ', & + '<1 1 . 1>{1 0 . 0} ', & + '<1 0 . 0>{1 1 . 0} ', & + '<1 1 . 0>{-1 1 . 1} ', & + '<1 1 . 3>{-1 0 . 1} ', & + '<1 1 . 3>{-1 -1 . 2}'] + real(pReal), dimension(4+4,LATTICE_hex_Ntwin), parameter, private :: & LATTICE_hex_systemTwin = reshape(real([& ! Compression or Tension =f(twinning shear=f(c/a)) for each metal ! (according to Yoo 1981) @@ -650,6 +671,12 @@ module lattice 1, 1, -2, -3, 1, 1, -2, 2 & ],pReal),[ 4_pInt + 4_pInt ,LATTICE_hex_Ntwin]) !< twin systems for hex, order follows Prof. Tom Bieler's scheme; but numbering in data was restarted from 1 + character(len=*), dimension(4), parameter, public :: LATTICE_HEX_TWINFAMILY_NAME = & + ['<-1 0 . 1>{1 0 . 2} ', & + '<1 1 . 6>{-1 -1 . 1}', & + '<1 0 . -2>{1 0 . 1} ', & + '<1 1 . -3>{1 1 . 2} '] + integer(pInt), dimension(LATTICE_hex_Ntwin), parameter, private :: & LATTICE_hex_shearTwin = reshape(int( [& ! indicator to formula further below 1, & ! <-10.1>{10.2} @@ -844,17 +871,17 @@ module lattice LATTICE_bct_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for bct integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_bct_NtransSystem = int([0,0],pInt) !< # of transformation systems per family for bct + LATTICE_bct_NtransSystem = int([0],pInt) !< # of transformation systems per family for bct integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_bct_NcleavageSystem = int([0,0,0],pInt) !< # of cleavage systems per family for bct + LATTICE_bct_NcleavageSystem = int([0, 0, 0],pInt) !< # of cleavage systems per family for bct integer(pInt), parameter, private :: & - LATTICE_bct_Nslip = 52_pInt, & !sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct - LATTICE_bct_Ntwin = 0_pInt, & !sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct + LATTICE_bct_Nslip = sum(lattice_bct_NslipSystem), & !< total # of slip systems for bct + LATTICE_bct_Ntwin = sum(lattice_bct_NtwinSystem), & !< total # of twin systems for bct LATTICE_bct_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for bct - LATTICE_bct_Ntrans = 0_pInt, & !sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct - LATTICE_bct_Ncleavage = 0_pInt !sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct + LATTICE_bct_Ntrans = sum(lattice_bct_NtransSystem), & !< total # of transformation systems for bct + LATTICE_bct_Ncleavage = sum(lattice_bct_NcleavageSystem) !< total # of cleavage systems for bct real(pReal), dimension(3+3,LATTICE_bct_Nslip), parameter, private :: & LATTICE_bct_systemSlip = reshape(real([& @@ -926,6 +953,21 @@ module lattice 1, 1, 1, 1,-2, 1 & ],pReal),[ 3_pInt + 3_pInt,LATTICE_bct_Nslip]) !< slip systems for bct sorted by Bieler + character(len=*), dimension(13), parameter, public :: LATTICE_BCT_SLIPFAMILY_NAME = & + ['{1 0 0)<0 0 1] ', & + '{1 1 0)<0 0 1] ', & + '{1 0 0)<0 1 0] ', & + '{1 1 0)<1 -1 1]', & + '{1 1 0)<1 -1 0]', & + '{1 0 0)<0 1 1] ', & + '{0 0 1)<0 1 0] ', & + '{0 0 1)<1 1 0] ', & + '{0 1 1)<0 1 -1]', & + '{0 1 1)<1 -1 1]', & + '{0 1 1)<1 0 0] ', & + '{2 1 1)<0 1 -1]', & + '{2 1 1)<-1 1 1]'] + integer(pInt), dimension(LATTICE_bct_Nslip,LATTICE_bct_Nslip), parameter, public :: & LATTICE_bct_interactionSlipSlip = reshape(int( [& 1, 2, 3, 3, 7, 7, 13, 13, 13, 13, 21, 21, 31, 31, 31, 31, 43, 43, 57, 57, 73, 73, 73, 73, 91, 91, 91, 91, 91, 91, 91, 91, 111, 111, 111, 111, 133,133,133,133,133,133,133,133, 157,157,157,157,157,157,157,157, & @@ -1004,17 +1046,17 @@ module lattice LATTICE_iso_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for iso integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_iso_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for iso + LATTICE_iso_NtransSystem = int([0],pInt) !< # of transformation systems per family for iso integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_iso_NcleavageSystem = int([3,0,0],pInt) !< # of cleavage systems per family for iso + LATTICE_iso_NcleavageSystem = int([3, 0, 0],pInt) !< # of cleavage systems per family for iso integer(pInt), parameter, private :: & - LATTICE_iso_Nslip = 0_pInt, & !sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso - LATTICE_iso_Ntwin = 0_pInt, & !sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso + LATTICE_iso_Nslip = sum(lattice_iso_NslipSystem), & !< total # of slip systems for iso + LATTICE_iso_Ntwin = sum(lattice_iso_NtwinSystem), & !< total # of twin systems for iso LATTICE_iso_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for iso - LATTICE_iso_Ntrans = 0_pInt, & !sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso - LATTICE_iso_Ncleavage = 3_pInt !sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso + LATTICE_iso_Ntrans = sum(lattice_iso_NtransSystem), & !< total # of transformation systems for iso + LATTICE_iso_Ncleavage = sum(lattice_iso_NcleavageSystem) !< total # of cleavage systems for iso real(pReal), dimension(3+3,LATTICE_iso_Ncleavage), parameter, private :: & LATTICE_iso_systemCleavage = reshape(real([& @@ -1033,17 +1075,17 @@ module lattice LATTICE_ortho_NtwinSystem = int([0, 0, 0, 0], pInt) !< # of twin systems per family for ortho integer(pInt), dimension(LATTICE_maxNtransFamily), parameter, public :: & - LATTICE_ortho_NtransSystem = int([0, 0],pInt) !< # of transformation systems per family for ortho + LATTICE_ortho_NtransSystem = int([0],pInt) !< # of transformation systems per family for ortho integer(pInt), dimension(LATTICE_maxNcleavageFamily), parameter, public :: & - LATTICE_ortho_NcleavageSystem = int([1,1,1],pInt) !< # of cleavage systems per family for ortho + LATTICE_ortho_NcleavageSystem = int([1, 1, 1],pInt) !< # of cleavage systems per family for ortho integer(pInt), parameter, private :: & - LATTICE_ortho_Nslip = 0_pInt, & !sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho - LATTICE_ortho_Ntwin = 0_pInt, & !sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho + LATTICE_ortho_Nslip = sum(lattice_ortho_NslipSystem), & !< total # of slip systems for ortho + LATTICE_ortho_Ntwin = sum(lattice_ortho_NtwinSystem), & !< total # of twin systems for ortho LATTICE_ortho_NnonSchmid = 0_pInt, & !< total # of non-Schmid contributions for ortho - LATTICE_ortho_Ntrans = 0_pInt, & !sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho - LATTICE_ortho_Ncleavage = 3_pInt !sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho + LATTICE_ortho_Ntrans = sum(lattice_ortho_NtransSystem), & !< total # of transformation systems for ortho + LATTICE_ortho_Ncleavage = sum(lattice_ortho_NcleavageSystem) !< total # of cleavage systems for ortho real(pReal), dimension(3+3,LATTICE_ortho_Ncleavage), parameter, private :: & LATTICE_ortho_systemCleavage = reshape(real([& @@ -1054,25 +1096,44 @@ module lattice ],pReal),[ 3_pInt + 3_pInt,LATTICE_ortho_Ncleavage]) integer(pInt), parameter, public :: & - LATTICE_maxNslip = 52_pInt, & - !LATTICE_maxNslip = maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,\ - ! LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip]), & !< max # of slip systems over lattice structures - LATTICE_maxNtwin = 24_pInt, & - !LATTICE_maxNtwin = maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin,\ - ! LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin]), & !< max # of twin systems over lattice structures - LATTICE_maxNnonSchmid = 6_pInt, & - !LATTICE_maxNtwin = maxval([LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid,\ - ! LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid,\ - ! LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid]), & !< max # of non-Schmid contributions over lattice structures - LATTICE_maxNtrans = 12_pInt, & - !LATTICE_maxNtrans = maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans,\ - ! LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans]),&!< max # of transformation systems over lattice structures - LATTICE_maxNcleavage = 9_pInt, & - !LATTICE_maxNcleavage = maxval([LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage,\ - ! LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage,\ - ! LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage]) !< max # of cleavage systems over lattice structures - LATTICE_maxNinteraction = 182_pInt !< max # of interaction types (in hardening matrix part) - + LATTICE_maxNslip = max(LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip, & + LATTICE_bct_Nslip,LATTICE_iso_Nslip,LATTICE_ortho_Nslip), & !< max # of slip systems over lattice structures + LATTICE_maxNtwin = max(LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin, & + LATTICE_bct_Ntwin,LATTICE_iso_Ntwin,LATTICE_ortho_Ntwin), & !< max # of twin systems over lattice structures + LATTICE_maxNnonSchmid = max(LATTICE_fcc_NnonSchmid,LATTICE_bcc_NnonSchmid, & + LATTICE_hex_NnonSchmid,LATTICE_bct_NnonSchmid, & + LATTICE_iso_NnonSchmid,LATTICE_ortho_NnonSchmid), & !< max # of non-Schmid contributions over lattice structures + LATTICE_maxNtrans = max(LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans, & + LATTICE_bct_Ntrans,LATTICE_iso_Ntrans,LATTICE_ortho_Ntrans), & !< max # of transformation systems over lattice structures + LATTICE_maxNcleavage = max(LATTICE_fcc_Ncleavage,LATTICE_bcc_Ncleavage, & + LATTICE_hex_Ncleavage,LATTICE_bct_Ncleavage, & + LATTICE_iso_Ncleavage,LATTICE_ortho_Ncleavage), & !< max # of cleavage systems over lattice structures +#if defined(__GFORTRAN__) + ! only supported in gcc 8 + LATTICE_maxNinteraction = 182_pInt +#else + LATTICE_maxNinteraction = max(& + maxval(lattice_fcc_interactionSlipSlip), & + maxval(lattice_bcc_interactionSlipSlip), & + maxval(lattice_hex_interactionSlipSlip), & + maxval(lattice_bct_interactionSlipSlip), & + ! + maxval(lattice_fcc_interactionSlipTwin), & + maxval(lattice_bcc_interactionSlipTwin), & + maxval(lattice_hex_interactionSlipTwin), & + !maxval(lattice_bct_interactionSlipTwin), & + ! + maxval(lattice_fcc_interactionTwinSlip), & + maxval(lattice_bcc_interactionTwinSlip), & + maxval(lattice_hex_interactionTwinSlip), & + !maxval(lattice_bct_interactionTwinSlip), & + ! + maxval(lattice_fcc_interactionTwinTwin), & + maxval(lattice_bcc_interactionTwinTwin), & + maxval(lattice_hex_interactionTwinTwin) & + !maxval(lattice_bct_interactionTwinTwin))) + ) !< max # of interaction types (in hardening matrix part) +#endif real(pReal), dimension(:,:,:), allocatable, public, protected :: & lattice_C66, lattice_trans_C66 real(pReal), dimension(:,:,:,:,:), allocatable, public, protected :: & @@ -1250,38 +1311,19 @@ subroutine lattice_init compiler_options #endif use IO, only: & - IO_open_file,& - IO_open_jobFile_stat, & - IO_countSections, & IO_error, & - IO_timeStamp, & - IO_EOF, & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue + IO_timeStamp use config, only: & - material_configfile, & - material_localFileExt, & - material_partPhase - use debug, only: & - debug_level, & - debug_lattice, & - debug_levelBasic + config_phase implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt integer(pInt) :: Nphases character(len=65536) :: & - tag = '', & - line = '' - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: section = 0_pInt,i + tag = '' + integer(pInt) :: i,p real(pReal), dimension(:), allocatable :: & - CoverA, & !!!!!!< c/a ratio for low symmetry type lattice + temp, & + CoverA, & !< c/a ratio for low symmetry type lattice CoverA_trans, & !< c/a ratio for transformed hex type lattice a_fcc, & !< lattice parameter a for fcc austenite a_bcc !< lattice paramater a for bcc martensite @@ -1290,90 +1332,7 @@ subroutine lattice_init write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" -!-------------------------------------------------------------------------------------------------- -! consistency checks (required since ifort 15.0 does not support sum/maxval in parameter definition) - - if (LATTICE_maxNslip /= maxval([LATTICE_fcc_Nslip,LATTICE_bcc_Nslip,LATTICE_hex_Nslip,LATTICE_bct_Nslip])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNslip') - if (LATTICE_maxNtwin /= maxval([LATTICE_fcc_Ntwin,LATTICE_bcc_Ntwin,LATTICE_hex_Ntwin])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtwin') - if (LATTICE_maxNtrans /= maxval([LATTICE_fcc_Ntrans,LATTICE_bcc_Ntrans,LATTICE_hex_Ntrans])) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNtrans') - if (LATTICE_maxNnonSchmid /= maxval([lattice_fcc_NnonSchmid,lattice_bcc_NnonSchmid,& - lattice_hex_NnonSchmid])) call IO_error(0_pInt,ext_msg = 'LATTICE_maxNnonSchmid') - - if (LATTICE_fcc_Nslip /= sum(lattice_fcc_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Nslip') - if (LATTICE_bcc_Nslip /= sum(lattice_bcc_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Nslip') - if (LATTICE_hex_Nslip /= sum(lattice_hex_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Nslip') - if (LATTICE_bct_Nslip /= sum(lattice_bct_NslipSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Nslip') - - if (LATTICE_fcc_Ntwin /= sum(lattice_fcc_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntwin') - if (LATTICE_bcc_Ntwin /= sum(lattice_bcc_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntwin') - if (LATTICE_hex_Ntwin /= sum(lattice_hex_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntwin') - if (LATTICE_bct_Ntwin /= sum(lattice_bct_NtwinSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntwin') - - if (LATTICE_fcc_Ntrans /= sum(lattice_fcc_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ntrans') - if (LATTICE_bcc_Ntrans /= sum(lattice_bcc_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ntrans') - if (LATTICE_hex_Ntrans /= sum(lattice_hex_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ntrans') - if (LATTICE_bct_Ntrans /= sum(lattice_bct_NtransSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ntrans') - - if (LATTICE_fcc_Ncleavage /= sum(lattice_fcc_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_fcc_Ncleavage') - if (LATTICE_bcc_Ncleavage /= sum(lattice_bcc_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bcc_Ncleavage') - if (LATTICE_hex_Ncleavage /= sum(lattice_hex_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_hex_Ncleavage') - if (LATTICE_bct_Ncleavage /= sum(lattice_bct_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_bct_Ncleavage') - if (LATTICE_iso_Ncleavage /= sum(lattice_iso_NcleavageSystem)) & - call IO_error(0_pInt,ext_msg = 'LATTICE_iso_Ncleavage') - - if (LATTICE_maxNinteraction /= max(& - maxval(lattice_fcc_interactionSlipSlip), & - maxval(lattice_bcc_interactionSlipSlip), & - maxval(lattice_hex_interactionSlipSlip), & - maxval(lattice_bct_interactionSlipSlip), & - ! - maxval(lattice_fcc_interactionSlipTwin), & - maxval(lattice_bcc_interactionSlipTwin), & - maxval(lattice_hex_interactionSlipTwin), & -! maxval(lattice_bct_interactionSlipTwin), & - ! - maxval(lattice_fcc_interactionTwinSlip), & - maxval(lattice_bcc_interactionTwinSlip), & - maxval(lattice_hex_interactionTwinSlip), & -! maxval(lattice_bct_interactionTwinSlip), & - ! - maxval(lattice_fcc_interactionTwinTwin), & - maxval(lattice_bcc_interactionTwinTwin), & - maxval(lattice_hex_interactionTwinTwin))) & -! maxval(lattice_bct_interactionTwinTwin))) & - call IO_error(0_pInt,ext_msg = 'LATTICE_maxNinteraction') - -!-------------------------------------------------------------------------------------------------- -! read from material configuration file - if (.not. IO_open_jobFile_stat(FILEUNIT,material_localFileExt)) & ! no local material configuration present... - call IO_open_file(FILEUNIT,material_configFile) ! ... open material.config file - Nphases = IO_countSections(FILEUNIT,material_partPhase) - - if(Nphases<1_pInt) & - call IO_error(160_pInt,Nphases, ext_msg='No phases found') - - if (iand(debug_level(debug_lattice),debug_levelBasic) /= 0_pInt) then - write(6,'(a16,1x,i5)') ' # phases:',Nphases - endif + Nphases = size(config_phase) allocate(lattice_structure(Nphases),source = LATTICE_undefined_ID) allocate(trans_lattice_structure(Nphases),source = LATTICE_undefined_ID) @@ -1450,177 +1409,99 @@ subroutine lattice_init allocate(a_fcc(Nphases),source=0.0_pReal) allocate(a_bcc(Nphases),source=0.0_pReal) - rewind(fileUnit) - line = '' ! to have it initialized - section = 0_pInt ! - " - - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo + do p = 1, size(config_phase) + tag = config_phase(p)%getString('lattice_structure') + select case(trim(tag)) + case('iso','isotropic') + lattice_structure(p) = LATTICE_iso_ID + case('fcc') + lattice_structure(p) = LATTICE_fcc_ID + case('bcc') + lattice_structure(p) = LATTICE_bcc_ID + case('hex','hexagonal') + lattice_structure(p) = LATTICE_hex_ID + case('bct') + lattice_structure(p) = LATTICE_bct_ID + case('ort','orthorhombic') + lattice_structure(p) = LATTICE_ort_ID + end select - do while (trim(line) /= IO_EOF) ! read through sections of material part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next section - section = section + 1_pInt - endif - if (section > 0_pInt) then - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - case('iso','isotropic') - lattice_structure(section) = LATTICE_iso_ID - case('fcc') - lattice_structure(section) = LATTICE_fcc_ID - case('bcc') - lattice_structure(section) = LATTICE_bcc_ID - case('hex','hexagonal') - lattice_structure(section) = LATTICE_hex_ID - case('bct') - lattice_structure(section) = LATTICE_bct_ID - case('ort','orthorhombic') - lattice_structure(section) = LATTICE_ort_ID - case default - call IO_error(130_pInt,ext_msg=trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - end select - case('trans_lattice_structure') - select case(trim(IO_lc(IO_stringValue(line,chunkPos,2_pInt)))) - case('bcc') - trans_lattice_structure(section) = LATTICE_bcc_ID - case('hex','hexagonal','hcp') - trans_lattice_structure(section) = LATTICE_hex_ID - end select - case ('c11') - lattice_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c12') - lattice_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c13') - lattice_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c22') - lattice_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c23') - lattice_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c33') - lattice_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c44') - lattice_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c55') - lattice_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c66') - lattice_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c11_trans') - lattice_trans_C66(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c12_trans') - lattice_trans_C66(1,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c13_trans') - lattice_trans_C66(1,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c22_trans') - lattice_trans_C66(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c23_trans') - lattice_trans_C66(2,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c33_trans') - lattice_trans_C66(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c44_trans') - lattice_trans_C66(4,4,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c55_trans') - lattice_trans_C66(5,5,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c66_trans') - lattice_trans_C66(6,6,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('covera_ratio','c/a_ratio','c/a') - CoverA(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('c/a_trans','c/a_martensite','c/a_mart') - CoverA_trans(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_fcc') - a_fcc(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_bcc') - a_bcc(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity11') - lattice_thermalConductivity33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity22') - lattice_thermalConductivity33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_conductivity33') - lattice_thermalConductivity33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('thermal_expansion11') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(1,1,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('thermal_expansion22') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(2,2,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('thermal_expansion33') - do i = 2_pInt, min(4,chunkPos(1)) ! read up to three parameters (constant, linear, quadratic with T) - lattice_thermalExpansion33(3,3,i-1_pInt,section) = IO_floatValue(line,chunkPos,i) - enddo - case ('specific_heat') - lattice_specificHeat(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyformationenergy') - lattice_vacancyFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancysurfaceenergy') - lattice_vacancySurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyvolume') - lattice_vacancyVol(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenformationenergy') - lattice_hydrogenFormationEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogensurfaceenergy') - lattice_hydrogenSurfaceEnergy(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenvolume') - lattice_hydrogenVol(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('mass_density') - lattice_massDensity(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('reference_temperature') - lattice_referenceTemperature(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion11') - lattice_DamageDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion22') - lattice_DamageDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_diffusion33') - lattice_DamageDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('damage_mobility') - lattice_DamageMobility(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion11') - lattice_vacancyfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion22') - lattice_vacancyfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_diffusion33') - lattice_vacancyfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility11') - lattice_vacancyfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility22') - lattice_vacancyfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancyflux_mobility33') - lattice_vacancyfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion11') - lattice_PorosityDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion22') - lattice_PorosityDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_diffusion33') - lattice_PorosityDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('porosity_mobility') - lattice_PorosityMobility(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion11') - lattice_hydrogenfluxDiffusion33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion22') - lattice_hydrogenfluxDiffusion33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_diffusion33') - lattice_hydrogenfluxDiffusion33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility11') - lattice_hydrogenfluxMobility33(1,1,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility22') - lattice_hydrogenfluxMobility33(2,2,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogenflux_mobility33') - lattice_hydrogenfluxMobility33(3,3,section) = IO_floatValue(line,chunkPos,2_pInt) - case ('vacancy_eqcv') - lattice_equilibriumVacancyConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) - case ('hydrogen_eqch') - lattice_equilibriumHydrogenConcentration(section) = IO_floatValue(line,chunkPos,2_pInt) - end select - endif + tag = 'undefined' + tag = config_phase(p)%getString('trans_lattice_structure',defaultVal=tag) + select case(trim(tag)) + case('bcc') + trans_lattice_structure(p) = LATTICE_bcc_ID + case('hex','hexagonal') + trans_lattice_structure(p) = LATTICE_hex_ID + end select + + lattice_C66(1,1,p) = config_phase(p)%getFloat('c11',defaultVal=0.0_pReal) + lattice_C66(1,2,p) = config_phase(p)%getFloat('c12',defaultVal=0.0_pReal) + lattice_C66(1,3,p) = config_phase(p)%getFloat('c13',defaultVal=0.0_pReal) + lattice_C66(2,2,p) = config_phase(p)%getFloat('c22',defaultVal=0.0_pReal) + lattice_C66(2,3,p) = config_phase(p)%getFloat('c23',defaultVal=0.0_pReal) + lattice_C66(3,3,p) = config_phase(p)%getFloat('c33',defaultVal=0.0_pReal) + lattice_C66(4,4,p) = config_phase(p)%getFloat('c44',defaultVal=0.0_pReal) + lattice_C66(5,5,p) = config_phase(p)%getFloat('c55',defaultVal=0.0_pReal) + lattice_C66(6,6,p) = config_phase(p)%getFloat('c66',defaultVal=0.0_pReal) + + lattice_trans_C66(1,1,p) = config_phase(p)%getFloat('c11_trans',defaultVal=0.0_pReal) + lattice_trans_C66(1,2,p) = config_phase(p)%getFloat('c12_trans',defaultVal=0.0_pReal) + lattice_trans_C66(1,3,p) = config_phase(p)%getFloat('c13_trans',defaultVal=0.0_pReal) + lattice_trans_C66(2,2,p) = config_phase(p)%getFloat('c22_trans',defaultVal=0.0_pReal) + lattice_trans_C66(2,3,p) = config_phase(p)%getFloat('c23_trans',defaultVal=0.0_pReal) + lattice_trans_C66(3,3,p) = config_phase(p)%getFloat('c33_trans',defaultVal=0.0_pReal) + lattice_trans_C66(4,4,p) = config_phase(p)%getFloat('c44_trans',defaultVal=0.0_pReal) + lattice_trans_C66(5,5,p) = config_phase(p)%getFloat('c55_trans',defaultVal=0.0_pReal) + lattice_trans_C66(6,6,p) = config_phase(p)%getFloat('c66_trans',defaultVal=0.0_pReal) + + CoverA(p) = config_phase(p)%getFloat('c/a',defaultVal=0.0_pReal) + CoverA_trans(p) = config_phase(p)%getFloat('c/a_trans',defaultVal=0.0_pReal) + a_fcc(p) = config_phase(p)%getFloat('a_fcc',defaultVal=0.0_pReal) + a_bcc(p) = config_phase(p)%getFloat('a_bcc',defaultVal=0.0_pReal) + + lattice_thermalConductivity33(1,1,p) = config_phase(p)%getFloat('thermal_conductivity11',defaultVal=0.0_pReal) + lattice_thermalConductivity33(2,2,p) = config_phase(p)%getFloat('thermal_conductivity22',defaultVal=0.0_pReal) + lattice_thermalConductivity33(3,3,p) = config_phase(p)%getFloat('thermal_conductivity33',defaultVal=0.0_pReal) + + temp = config_phase(p)%getFloats('thermal_expansion11',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(1,1,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion22',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(2,2,1:size(temp),p) = temp + temp = config_phase(p)%getFloats('thermal_expansion33',defaultVal=[0.0_pReal]) ! read up to three parameters (constant, linear, quadratic with T) + lattice_thermalExpansion33(3,3,1:size(temp),p) = temp + + lattice_specificHeat(p) = config_phase(p)%getFloat( 'specific_heat',defaultVal=0.0_pReal) + lattice_vacancyFormationEnergy(p) = config_phase(p)%getFloat( 'vacancyformationenergy',defaultVal=0.0_pReal) + lattice_vacancySurfaceEnergy(p) = config_phase(p)%getFloat( 'vacancyvolume',defaultVal=0.0_pReal) + lattice_vacancyVol(p) = config_phase(p)%getFloat( 'vacancysurfaceenergy',defaultVal=0.0_pReal) + lattice_hydrogenFormationEnergy(p) = config_phase(p)%getFloat( 'hydrogenformationenergy',defaultVal=0.0_pReal) + lattice_hydrogenSurfaceEnergy(p) = config_phase(p)%getFloat( 'hydrogensurfaceenergy',defaultVal=0.0_pReal) + lattice_hydrogenVol(p) = config_phase(p)%getFloat( 'hydrogenvolume',defaultVal=0.0_pReal) + lattice_massDensity(p) = config_phase(p)%getFloat( 'mass_density',defaultVal=0.0_pReal) + lattice_referenceTemperature(p) = config_phase(p)%getFloat( 'reference_temperature',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(1,1,p) = config_phase(p)%getFloat( 'damage_diffusion11',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(2,2,p) = config_phase(p)%getFloat( 'damage_diffusion22',defaultVal=0.0_pReal) + lattice_DamageDiffusion33(3,3,p) = config_phase(p)%getFloat( 'damage_diffusion33',defaultVal=0.0_pReal) + lattice_DamageMobility(p) = config_phase(p)%getFloat( 'damage_mobility',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion11',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion22',defaultVal=0.0_pReal) + lattice_vacancyfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_diffusion33',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'vacancyflux_mobility11',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'vacancyflux_mobility22',defaultVal=0.0_pReal) + lattice_vacancyfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'vacancyflux_mobility33',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(1,1,p) = config_phase(p)%getFloat( 'porosity_diffusion11',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(2,2,p) = config_phase(p)%getFloat( 'porosity_diffusion22',defaultVal=0.0_pReal) + lattice_PorosityDiffusion33(3,3,p) = config_phase(p)%getFloat( 'porosity_diffusion33',defaultVal=0.0_pReal) + lattice_PorosityMobility(p) = config_phase(p)%getFloat( 'porosity_mobility',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion11',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion22',defaultVal=0.0_pReal) + lattice_hydrogenfluxDiffusion33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_diffusion33',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(1,1,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility11',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(2,2,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility22',defaultVal=0.0_pReal) + lattice_hydrogenfluxMobility33(3,3,p) = config_phase(p)%getFloat( 'hydrogenflux_mobility33',defaultVal=0.0_pReal) + lattice_equilibriumVacancyConcentration(p) = config_phase(p)%getFloat( 'vacancy_eqcv',defaultVal=0.0_pReal) + lattice_equilibriumHydrogenConcentration(p) = config_phase(p)%getFloat( 'hydrogen_eqch',defaultVal=0.0_pReal) enddo do i = 1_pInt,Nphases @@ -1631,8 +1512,6 @@ subroutine lattice_init call lattice_initializeStructure(i, CoverA(i), CoverA_trans(i), a_fcc(i), a_bcc(i)) enddo - deallocate(CoverA,CoverA_trans,a_fcc,a_bcc) - end subroutine lattice_init @@ -1790,16 +1669,16 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) myNtwin = lattice_fcc_Ntwin myNtrans = lattice_fcc_Ntrans myNcleavage = lattice_fcc_Ncleavage - do i = 1_pInt,myNslip ! assign slip system vectors + do i = 1_pInt,myNslip ! assign slip system vectors sd(1:3,i) = lattice_fcc_systemSlip(1:3,i) sn(1:3,i) = lattice_fcc_systemSlip(4:6,i) enddo - do i = 1_pInt,myNtwin ! assign twin system vectors and shears + do i = 1_pInt,myNtwin ! assign twin system vectors and shears td(1:3,i) = lattice_fcc_systemTwin(1:3,i) tn(1:3,i) = lattice_fcc_systemTwin(4:6,i) ts(i) = lattice_fcc_shearTwin(i) enddo - do i = 1_pInt, myNcleavage ! assign cleavage system vectors + do i = 1_pInt, myNcleavage ! assign cleavage system vectors cd(1:3,i) = lattice_fcc_systemCleavage(1:3,i)/norm2(lattice_fcc_systemCleavage(1:3,i)) cn(1:3,i) = lattice_fcc_systemCleavage(4:6,i)/norm2(lattice_fcc_systemCleavage(4:6,i)) ct(1:3,i) = math_crossproduct(cd(1:3,i),cn(1:3,i)) @@ -1807,16 +1686,16 @@ subroutine lattice_initializeStructure(myPhase,CoverA,CoverA_trans,a_fcc,a_bcc) ! Phase transformation select case(trans_lattice_structure(myPhase)) - case (LATTICE_bcc_ID) ! fcc to bcc transformation + case (LATTICE_bcc_ID) ! fcc to bcc transformation do i = 1_pInt,myNtrans - Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation + Rtr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_systemTrans(1:3,i), & ! Pitsch rotation lattice_fccTobcc_systemTrans(4,i)*INRAD) - Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system + Btr(1:3,1:3,i) = math_axisAngleToR(lattice_fccTobcc_bainRot(1:3,i), & ! Rotation of fcc to Bain coordinate system lattice_fccTobcc_bainRot(4,i)*INRAD) xtr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(1:3,i),pReal) ytr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(4:6,i),pReal) ztr(1:3,i) = real(LATTICE_fccTobcc_bainVariant(7:9,i),pReal) - Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation + Utr(1:3,1:3,i) = 0.0_pReal ! Bain deformation if ((a_fcc > 0.0_pReal) .and. (a_bcc > 0.0_pReal)) then Utr(1:3,1:3,i) = (a_bcc/a_fcc)*math_tensorproduct33(xtr(1:3,i), xtr(1:3,i)) + & sqrt(2.0_pReal)*(a_bcc/a_fcc)*math_tensorproduct33(ytr(1:3,i), ytr(1:3,i)) + & diff --git a/src/material.f90 b/src/material.f90 index d71fbb37a..812b0c55d 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -16,8 +16,8 @@ module material tSourceState, & tHomogMapping, & tPhaseMapping, & - p_vec, & - p_intvec + group_float, & + group_int implicit none private @@ -268,7 +268,7 @@ module material porosityMapping, & !< mapping for porosity state/fields hydrogenfluxMapping !< mapping for hydrogen conc state/fields - type(p_vec), allocatable, dimension(:), public :: & + type(group_float), allocatable, dimension(:), public :: & temperature, & !< temperature field damage, & !< damage field vacancyConc, & !< vacancy conc field @@ -360,8 +360,7 @@ subroutine material_init() homogenization_name, & microstructure_name, & phase_name, & - texture_name, & - config_deallocate + texture_name use mesh, only: & mesh_maxNips, & mesh_NcpElems, & @@ -370,7 +369,7 @@ subroutine material_init() FE_geomtype implicit none - integer(pInt), parameter :: FILEUNIT = 200_pInt + integer(pInt), parameter :: FILEUNIT = 210_pInt integer(pInt) :: m,c,h, myDebug, myPhase, myHomog integer(pInt) :: & g, & !< grain number @@ -469,7 +468,6 @@ subroutine material_init() endif debugOut call material_populateGrains - call config_deallocate('material.config/microstructure') allocate(phaseAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) allocate(phasememberAt ( homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems),source=0_pInt) @@ -921,8 +919,8 @@ subroutine material_parseTexture IO_floatValue, & IO_stringValue use config, only: & - config_texture, & - config_deallocate + config_deallocate, & + config_texture use math, only: & inRad, & math_sampleRandomOri, & @@ -1061,7 +1059,7 @@ subroutine material_parseTexture endif enddo - call config_deallocate('material.config/texture') + call config_deallocate('material.config/texture') end subroutine material_parseTexture @@ -1093,6 +1091,7 @@ subroutine material_populateGrains use config, only: & config_homogenization, & config_microstructure, & + config_deallocate, & homogenization_name, & microstructure_name use IO, only: & @@ -1120,8 +1119,8 @@ subroutine material_populateGrains phaseID,textureID,dGrains,myNgrains,myNorientations,myNconstituents, & grain,constituentGrain,ipGrain,symExtension, ip real(pReal) :: deviation,extreme,rnd - integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array - type(p_intvec), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array + integer(pInt), dimension (:,:), allocatable :: Nelems ! counts number of elements in homog, micro array + type(group_int), dimension (:,:), allocatable :: elemsOfHomogMicro ! lists element number in homog, micro array myDebug = debug_level(debug_material) @@ -1429,6 +1428,7 @@ subroutine material_populateGrains deallocate(texture_transformation) deallocate(Nelems) deallocate(elemsOfHomogMicro) + call config_deallocate('material.config/microstructure') end subroutine material_populateGrains diff --git a/src/math.f90 b/src/math.f90 index 56b2cb257..d8f0da778 100644 --- a/src/math.f90 +++ b/src/math.f90 @@ -378,8 +378,10 @@ pure function math_expand(what,how) integer(pInt), dimension(:), intent(in) :: how real(pReal), dimension(sum(how)) :: math_expand integer(pInt) :: i - if(sum(how)==0) & + + if (sum(how) == 0_pInt) & return + do i = 1_pInt, size(how) math_expand(sum(how(1:i-1))+1:sum(how(1:i))) = what(mod(i-1_pInt,size(what))+1_pInt) enddo diff --git a/src/mesh.f90 b/src/mesh.f90 index 5606b656b..4e72ba73e 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -95,9 +95,11 @@ module mesh integer(pInt), dimension(:,:), allocatable, private :: & mesh_cellnodeParent !< cellnode's parent element ID, cellnode's intra-element ID +#if defined(Marc4DAMASK) || defined(Abaqus) integer(pInt), dimension(:,:), allocatable, target, private :: & mesh_mapFEtoCPelem, & !< [sorted FEid, corresponding CPid] mesh_mapFEtoCPnode !< [sorted FEid, corresponding CPid] +#endif integer(pInt),dimension(:,:,:), allocatable, private :: & mesh_cell !< cell connectivity for each element,ip/cell @@ -402,7 +404,9 @@ module mesh public :: & mesh_init, & +#if defined(Marc4DAMASK) || defined(Abaqus) mesh_FEasCP, & +#endif mesh_build_cellnodes, & mesh_build_ipVolumes, & mesh_build_ipCoordinates, & @@ -420,7 +424,6 @@ module mesh #ifdef Spectral mesh_spectral_getHomogenization, & mesh_spectral_count, & - mesh_spectral_mapNodesAndElems, & mesh_spectral_count_cpSizes, & mesh_spectral_build_nodes, & mesh_spectral_build_elements, & @@ -552,8 +555,6 @@ subroutine mesh_init(ip,el) if (myDebug) write(6,'(a)') ' Grid partitioned'; flush(6) call mesh_spectral_count() if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) - call mesh_spectral_mapNodesAndElems - if (myDebug) write(6,'(a)') ' Mapped nodes and elements'; flush(6) call mesh_spectral_count_cpSizes if (myDebug) write(6,'(a)') ' Built CP statistics'; flush(6) call mesh_spectral_build_nodes() @@ -659,12 +660,16 @@ subroutine mesh_init(ip,el) allocate(calcMode(mesh_maxNips,mesh_NcpElems)) calcMode = .false. ! pretend to have collected what first call is asking (F = I) +#if defined(Marc4DAMASK) || defined(Abaqus) calcMode(ip,mesh_FEasCP('elem',el)) = .true. ! first ip,el needs to be already pingponged to "calc" - +#else + calcMode(ip,el) = .true. ! first ip,el needs to be already pingponged to "calc" +#endif end subroutine mesh_init +#if defined(Marc4DAMASK) || defined(Abaqus) !-------------------------------------------------------------------------------------------------- !> @brief Gives the FE to CP ID mapping by binary search through lookup array !! valid questions (what) are 'elem', 'node' @@ -713,7 +718,7 @@ integer(pInt) function mesh_FEasCP(what,myID) enddo binarySearch end function mesh_FEasCP - +#endif !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. @@ -1188,24 +1193,6 @@ subroutine mesh_spectral_count() end subroutine mesh_spectral_count -!-------------------------------------------------------------------------------------------------- -!> @brief fake map node from FE ID to internal (consecutive) representation for node and element -!! Allocates global array 'mesh_mapFEtoCPnode' and 'mesh_mapFEtoCPelem' -!-------------------------------------------------------------------------------------------------- -subroutine mesh_spectral_mapNodesAndElems - use math, only: & - math_range - - implicit none - allocate (mesh_mapFEtoCPnode(2_pInt,mesh_Nnodes), source = 0_pInt) - allocate (mesh_mapFEtoCPelem(2_pInt,mesh_NcpElems), source = 0_pInt) - - mesh_mapFEtoCPnode = spread(math_range(mesh_Nnodes),1,2) - mesh_mapFEtoCPelem = spread(math_range(mesh_NcpElems),1,2) - -end subroutine mesh_spectral_mapNodesAndElems - - !-------------------------------------------------------------------------------------------------- !> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. !! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', diff --git a/src/meshFEM.f90 b/src/meshFEM.f90 new file mode 100644 index 000000000..7d79dd46d --- /dev/null +++ b/src/meshFEM.f90 @@ -0,0 +1,356 @@ +!-------------------------------------------------------------------------------------------------- +!> @author Pratheek Shanthraj, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH +!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH +!> @brief Driver controlling inner and outer load case looping of the FEM solver +!> @details doing cutbacking, forwarding in case of restart, reporting statistics, writing +!> results +!-------------------------------------------------------------------------------------------------- +module mesh +#include +#include + use prec, only: pReal, pInt + +use PETScdmda +use PETScis + + implicit none + private + + integer(pInt), public, protected :: & + mesh_Nboundaries, & + mesh_NcpElems, & !< total number of CP elements in mesh + mesh_NcpElemsGlobal, & + mesh_Nnodes, & !< total number of nodes in mesh + mesh_maxNnodes, & !< max number of nodes in any CP element + mesh_maxNips, & !< max number of IPs in any CP element + mesh_maxNipNeighbors, & + mesh_Nelems !< total number of elements in mesh + + real(pReal), public, protected :: charLength + + integer(pInt), dimension(:,:), allocatable, public, protected :: & + mesh_element !< FEid, type(internal representation), material, texture, node indices as CP IDs + + real(pReal), dimension(:,:), allocatable, public :: & + mesh_node !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) + + real(pReal), dimension(:,:), allocatable, public, protected :: & + mesh_ipVolume, & !< volume associated with IP (initially!) + mesh_node0 !< node x,y,z coordinates (initially!) + + real(pReal), dimension(:,:,:), allocatable, public :: & + mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) + + real(pReal), dimension(:,:,:), allocatable, public, protected :: & + mesh_ipArea !< area of interface to neighboring IP (initially!) + + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) + + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & + mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] + + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) + + DM, public :: geomMesh + + integer(pInt), dimension(:), allocatable, public, protected :: & + mesh_boundaries + + + integer(pInt), parameter, public :: & + FE_Nelemtypes = 1_pInt, & + FE_Ngeomtypes = 1_pInt, & + FE_Ncelltypes = 1_pInt, & + FE_maxNnodes = 1_pInt, & + FE_maxNips = 14_pInt + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type + int([1],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), parameter, public :: FE_celltype = & !< cell type that is used by each geometry type + int([1],pInt) + + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_Nnodes = & !< number of nodes that constitute a specific type of element + int([0],pInt) + + integer(pInt), dimension(FE_Ngeomtypes), public :: FE_Nips = & !< number of IPs in a specific type of element + int([0],pInt) + + integer(pInt), dimension(FE_Ncelltypes), parameter, public :: FE_NipNeighbors = & !< number of ip neighbors / cell faces in a specific cell type + int([6],pInt) + + + public :: & + mesh_init, & + mesh_FEM_build_ipVolumes, & + mesh_FEM_build_ipCoordinates, & + mesh_cellCenterCoordinates + + external :: & + DMPlexCreateFromFile, & + DMPlexDistribute, & + DMPlexCopyCoordinates, & + DMGetStratumSize, & + DMPlexGetHeightStratum, & + DMPlexGetLabelValue, & + DMPlexSetLabelValue + +contains + + +!-------------------------------------------------------------------------------------------------- +!> @brief initializes the mesh by calling all necessary private routines the mesh module +!! Order and routines strongly depend on type of solver +!-------------------------------------------------------------------------------------------------- +subroutine mesh_init(ip,el) + use DAMASK_interface + use, intrinsic :: iso_fortran_env ! to get compiler_version and compiler_options (at least for gfortran 4.6 at the moment) + use IO, only: & + IO_timeStamp, & + IO_error, & + IO_open_file, & + IO_stringPos, & + IO_intValue, & + IO_EOF, & + IO_read, & + IO_isBlank + use debug, only: & + debug_e, & + debug_i + use numerics, only: & + usePingPong, & + integrationOrder, & + worldrank, & + worldsize + use FEsolving, only: & + FEsolving_execElem, & + FEsolving_execIP, & + calcMode + use FEM_Zoo, only: & + FEM_Zoo_nQuadrature, & + FEM_Zoo_QuadraturePoints + + implicit none + integer(pInt), parameter :: FILEUNIT = 222_pInt + integer(pInt), intent(in) :: el, ip + integer(pInt) :: j + integer(pInt), allocatable, dimension(:) :: chunkPos + integer :: dimPlex + character(len=512) :: & + line + logical :: flag + PetscSF :: sf + DM :: globalMesh + PetscInt :: face, nFaceSets + PetscInt, pointer :: pFaceSets(:) + IS :: faceSetIS + PetscErrorCode :: ierr + + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +#include "compilation_info.f90" + + call DMPlexCreateFromFile(PETSC_COMM_WORLD,geometryFile,PETSC_TRUE,globalMesh,ierr) + CHKERRQ(ierr) + call DMGetDimension(globalMesh,dimPlex,ierr) + CHKERRQ(ierr) + call DMGetStratumSize(globalMesh,'depth',dimPlex,mesh_NcpElemsGlobal,ierr) + CHKERRQ(ierr) + call DMGetLabelSize(globalMesh,'Face Sets',mesh_Nboundaries,ierr) + CHKERRQ(ierr) + call MPI_Bcast(mesh_Nboundaries,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + call MPI_Bcast(mesh_NcpElemsGlobal,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + call MPI_Bcast(dimPlex,1,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + + allocate(mesh_boundaries(mesh_Nboundaries), source = 0_pInt) + call DMGetLabelSize(globalMesh,'Face Sets',nFaceSets,ierr) + CHKERRQ(ierr) + call DMGetLabelIdIS(globalMesh,'Face Sets',faceSetIS,ierr) + CHKERRQ(ierr) + if (nFaceSets > 0) call ISGetIndicesF90(faceSetIS,pFaceSets,ierr) + do face = 1, nFaceSets + mesh_boundaries(face) = pFaceSets(face) + enddo + if (nFaceSets > 0) call ISRestoreIndicesF90(faceSetIS,pFaceSets,ierr) + call MPI_Bcast(mesh_boundaries,mesh_Nboundaries,MPI_INTEGER,0,PETSC_COMM_WORLD,ierr) + + if (worldrank == 0) then + j = 0 + flag = .false. + call IO_open_file(FILEUNIT,trim(geometryFile)) + do + read(FILEUNIT,'(a512)') line + if (trim(line) == IO_EOF) exit ! skip empty lines + if (trim(line) == '$Elements') then + read(FILEUNIT,'(a512)') line + read(FILEUNIT,'(a512)') line + flag = .true. + endif + if (trim(line) == '$EndElements') exit + if (flag) then + chunkPos = IO_stringPos(line) + if (chunkPos(1) == 3+IO_intValue(line,chunkPos,3)+dimPlex+1) then + call DMSetLabelValue(globalMesh,'material',j,IO_intValue(line,chunkPos,4),ierr) + CHKERRQ(ierr) + j = j + 1 + endif ! count all identifiers to allocate memory and do sanity check + endif + enddo + close (FILEUNIT) + endif + + if (worldsize > 1) then + call DMPlexDistribute(globalMesh,0,sf,geomMesh,ierr) + CHKERRQ(ierr) + else + call DMClone(globalMesh,geomMesh,ierr) + CHKERRQ(ierr) + endif + call DMDestroy(globalMesh,ierr); CHKERRQ(ierr) + + call DMGetStratumSize(geomMesh,'depth',dimPlex,mesh_Nelems,ierr) + CHKERRQ(ierr) + call DMGetStratumSize(geomMesh,'depth',0,mesh_Nnodes,ierr) + CHKERRQ(ierr) + mesh_NcpElems = mesh_Nelems + + FE_Nips(FE_geomtype(1_pInt)) = FEM_Zoo_nQuadrature(dimPlex,integrationOrder) + mesh_maxNnodes = FE_Nnodes(1_pInt) + mesh_maxNips = FE_Nips(1_pInt) + call mesh_FEM_build_ipCoordinates(dimPlex,FEM_Zoo_QuadraturePoints(dimPlex,integrationOrder)%p) + call mesh_FEM_build_ipVolumes(dimPlex) + + allocate (mesh_element (4_pInt+mesh_maxNnodes,mesh_NcpElems)); mesh_element = 0_pInt + do j = 1, mesh_NcpElems + mesh_element( 1,j) = j + mesh_element( 2,j) = 1_pInt ! elem type + mesh_element( 3,j) = 1_pInt ! homogenization + call DMGetLabelValue(geomMesh,'material',j-1,mesh_element(4,j),ierr) + CHKERRQ(ierr) + end do + + if (usePingPong .and. (mesh_Nelems /= mesh_NcpElems)) & + call IO_error(600_pInt) ! ping-pong must be disabled when having non-DAMASK elements + if (debug_e < 1 .or. debug_e > mesh_NcpElems) & + call IO_error(602_pInt,ext_msg='element') ! selected element does not exist + if (debug_i < 1 .or. debug_i > FE_Nips(FE_geomtype(mesh_element(2_pInt,debug_e)))) & + call IO_error(602_pInt,ext_msg='IP') ! selected element does not have requested IP + + FEsolving_execElem = [ 1_pInt,mesh_NcpElems ] ! parallel loop bounds set to comprise all DAMASK elements + if (allocated(FEsolving_execIP)) deallocate(FEsolving_execIP) + allocate(FEsolving_execIP(2_pInt,mesh_NcpElems)); FEsolving_execIP = 1_pInt ! parallel loop bounds set to comprise from first IP... + forall (j = 1_pInt:mesh_NcpElems) FEsolving_execIP(2,j) = FE_Nips(FE_geomtype(mesh_element(2,j))) ! ...up to own IP count for each element + + if (allocated(calcMode)) deallocate(calcMode) + allocate(calcMode(mesh_maxNips,mesh_NcpElems)) + calcMode = .false. ! pretend to have collected what first call is asking (F = I) + calcMode(ip,el) = .true. ! first ip,el needs to be already pingponged to "calc" + +end subroutine mesh_init + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates cell center coordinates. +!-------------------------------------------------------------------------------------------------- +pure function mesh_cellCenterCoordinates(ip,el) + + implicit none + integer(pInt), intent(in) :: el, & !< element number + ip !< integration point number + real(pReal), dimension(3) :: mesh_cellCenterCoordinates !< x,y,z coordinates of the cell center of the requested IP cell + + end function mesh_cellCenterCoordinates + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP volume. Allocates global array 'mesh_ipVolume' +!> @details The IP volume is calculated differently depending on the cell type. +!> 2D cells assume an element depth of one in order to calculate the volume. +!> For the hexahedral cell we subdivide the cell into subvolumes of pyramidal +!> shape with a cell face as basis and the central ip at the tip. This subvolume is +!> calculated as an average of four tetrahedals with three corners on the cell face +!> and one corner at the central ip. +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_build_ipVolumes(dimPlex) + use math, only: & + math_I3, & + math_det33 + + implicit none + PetscInt :: dimPlex + PetscReal :: vol + PetscReal, target :: cent(dimPlex), norm(dimPlex) + PetscReal, pointer :: pCent(:), pNorm(:) + PetscInt :: cellStart, cellEnd, cell + PetscErrorCode :: ierr + + if (.not. allocated(mesh_ipVolume)) then + allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) + mesh_ipVolume = 0.0_pReal + endif + + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + pCent => cent + pNorm => norm + do cell = cellStart, cellEnd-1 + call DMPlexComputeCellGeometryFVM(geomMesh,cell,vol,pCent,pNorm,ierr) + CHKERRQ(ierr) + mesh_ipVolume(:,cell+1) = vol/real(mesh_maxNips,pReal) + enddo + +end subroutine mesh_FEM_build_ipVolumes + + +!-------------------------------------------------------------------------------------------------- +!> @brief Calculates IP Coordinates. Allocates global array 'mesh_ipCoordinates' +! Called by all solvers in mesh_init in order to initialize the ip coordinates. +! Later on the current ip coordinates are directly prvided by the spectral solver and by Abaqus, +! so no need to use this subroutine anymore; Marc however only provides nodal displacements, +! so in this case the ip coordinates are always calculated on the basis of this subroutine. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! FOR THE MOMENT THIS SUBROUTINE ACTUALLY CALCULATES THE CELL CENTER AND NOT THE IP COORDINATES, +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!-------------------------------------------------------------------------------------------------- +subroutine mesh_FEM_build_ipCoordinates(dimPlex,qPoints) + + implicit none + PetscInt, intent(in) :: dimPlex + PetscReal, intent(in) :: qPoints(mesh_maxNips*dimPlex) + PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), invcellJ(dimPlex*dimPlex) + PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) + PetscReal :: detJ + PetscInt :: cellStart, cellEnd, cell, qPt, dirI, dirJ, qOffset + PetscErrorCode :: ierr + + + allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) + + pV0 => v0 + pCellJ => cellJ + pInvcellJ => invcellJ + call DMPlexGetHeightStratum(geomMesh,0,cellStart,cellEnd,ierr); CHKERRQ(ierr) + do cell = cellStart, cellEnd-1 !< loop over all elements + call DMPlexComputeCellGeometryAffineFEM(geomMesh,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) + CHKERRQ(ierr) + qOffset = 0 + do qPt = 1, mesh_maxNips + do dirI = 1, dimPlex + mesh_ipCoordinates(dirI,qPt,cell+1) = pV0(dirI) + do dirJ = 1, dimPlex + mesh_ipCoordinates(dirI,qPt,cell+1) = mesh_ipCoordinates(dirI,qPt,cell+1) + & + pCellJ((dirI-1)*dimPlex+dirJ)*(qPoints(qOffset+dirJ) + 1.0) + enddo + enddo + qOffset = qOffset + dimPlex + enddo + enddo + +end subroutine mesh_FEM_build_ipCoordinates + +end module mesh diff --git a/src/numerics.f90 b/src/numerics.f90 index 8de664248..c93c4ddd7 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -16,7 +16,6 @@ module numerics integer(pInt), protected, public :: & iJacoStiffness = 1_pInt, & !< frequency of stiffness update iJacoLpresiduum = 1_pInt, & !< frequency of Jacobian update of residuum in Lp - nHomog = 20_pInt, & !< homogenization loop limit (only for debugging info, loop limit is determined by "subStepMinHomog") nMPstate = 10_pInt, & !< materialpoint state loop limit nCryst = 20_pInt, & !< crystallite loop limit (only for debugging info, loop limit is determined by "subStepMinCryst") nState = 10_pInt, & !< state loop limit @@ -27,9 +26,8 @@ module numerics worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only) integer(4), protected, public :: & DAMASK_NumThreadsInt = 0 !< value stored in environment variable DAMASK_NUM_THREADS, set to zero if no OpenMP directive - integer(pInt), public :: & - numerics_integrationMode = 0_pInt !< integrationMode 1 = central solution; integrationMode 2 = perturbation, Default 0: undefined, is not read from file - integer(pInt), dimension(2) , protected, public :: & + !< ToDo: numerics_integrator is an array for historical reasons, only element 1 is used! + integer(pInt), dimension(2), protected, public :: & numerics_integrator = 1_pInt !< method used for state integration (central & perturbed state), Default 1: fix-point iteration for both states real(pReal), protected, public :: & relevantStrain = 1.0e-7_pReal, & !< strain increment considered significant (used by crystallite to determine whether strain inc is considered significant) @@ -95,7 +93,7 @@ module numerics ! spectral parameters: #ifdef Spectral real(pReal), protected, public :: & - err_div_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for equilibrium + err_div_tolAbs = 1.0e-4_pReal, & !< absolute tolerance for equilibrium err_div_tolRel = 5.0e-4_pReal, & !< relative tolerance for equilibrium err_curl_tolAbs = 1.0e-10_pReal, & !< absolute tolerance for compatibility err_curl_tolRel = 5.0e-4_pReal, & !< relative tolerance for compatibility @@ -284,8 +282,6 @@ subroutine numerics_init pert_Fg = IO_floatValue(line,chunkPos,2_pInt) case ('pert_method') pert_method = IO_intValue(line,chunkPos,2_pInt) - case ('nhomog') - nHomog = IO_intValue(line,chunkPos,2_pInt) case ('nmpstate') nMPstate = IO_intValue(line,chunkPos,2_pInt) case ('ncryst') @@ -317,9 +313,7 @@ subroutine numerics_init case ('atol_crystallitestress') aTol_crystalliteStress = IO_floatValue(line,chunkPos,2_pInt) case ('integrator') - numerics_integrator(1) = IO_intValue(line,chunkPos,2_pInt) - case ('integratorstiffness') - numerics_integrator(2) = IO_intValue(line,chunkPos,2_pInt) + numerics_integrator = IO_intValue(line,chunkPos,2_pInt) case ('usepingpong') usepingpong = IO_intValue(line,chunkPos,2_pInt) > 0_pInt case ('timesyncing') @@ -536,7 +530,6 @@ subroutine numerics_init write(6,'(a24,1x,L8)') ' use ping pong scheme: ',usepingpong write(6,'(a24,1x,es8.1,/)')' unitlength: ',numerics_unitlength - write(6,'(a24,1x,i8)') ' nHomog: ',nHomog write(6,'(a24,1x,es8.1)') ' subStepMinHomog: ',subStepMinHomog write(6,'(a24,1x,es8.1)') ' subStepSizeHomog: ',subStepSizeHomog write(6,'(a24,1x,es8.1)') ' stepIncreaseHomog: ',stepIncreaseHomog @@ -646,7 +639,6 @@ subroutine numerics_init if (pert_Fg <= 0.0_pReal) call IO_error(301_pInt,ext_msg='pert_Fg') if (pert_method <= 0_pInt .or. pert_method >= 4_pInt) & call IO_error(301_pInt,ext_msg='pert_method') - if (nHomog < 1_pInt) call IO_error(301_pInt,ext_msg='nHomog') if (nMPstate < 1_pInt) call IO_error(301_pInt,ext_msg='nMPstate') if (nCryst < 1_pInt) call IO_error(301_pInt,ext_msg='nCryst') if (nState < 1_pInt) call IO_error(301_pInt,ext_msg='nState') diff --git a/src/plastic_isotropic.f90 b/src/plastic_isotropic.f90 index 264fe7e18..d65fe583f 100644 --- a/src/plastic_isotropic.f90 +++ b/src/plastic_isotropic.f90 @@ -109,11 +109,9 @@ use IO type(tParameters), pointer :: prm integer(pInt) :: & - o, & phase, & instance, & maxNinstance, & - mySize, & sizeDotState, & sizeState, & sizeDeltaState @@ -136,7 +134,6 @@ use IO plastic_isotropic_output = '' allocate(plastic_isotropic_Noutput(maxNinstance), source=0_pInt) -! inernal variable allocate(param(maxNinstance)) ! one container of parameters per instance allocate(state(maxNinstance)) ! internal state aliases allocate(dotState(maxNinstance)) diff --git a/src/plastic_none.f90 b/src/plastic_none.f90 index 140754556..5470c4a43 100644 --- a/src/plastic_none.f90 +++ b/src/plastic_none.f90 @@ -4,16 +4,9 @@ !> @brief material subroutine for purely elastic material !-------------------------------------------------------------------------------------------------- module plastic_none - use prec, only: & - pInt implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_none_sizePostResults - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_none_sizePostResult !< size of each post result output public :: & plastic_none_init @@ -31,6 +24,8 @@ subroutine plastic_none_init compiler_version, & compiler_options #endif + use prec, only: & + pInt use debug, only: & debug_level, & debug_constitutive, & @@ -51,18 +46,13 @@ subroutine plastic_none_init integer(pInt) :: & maxNinstance, & phase, & - NofMyPhase, & - sizeState, & - sizeDotState, & - sizeDeltaState + NofMyPhase write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_NONE_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" maxNinstance = int(count(phase_plasticity == PLASTICITY_none_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance @@ -70,37 +60,25 @@ subroutine plastic_none_init if (phase_plasticity(phase) == PLASTICITY_none_ID) then NofMyPhase=count(material_phase==phase) - sizeState = 0_pInt - plasticState(phase)%sizeState = sizeState - sizeDotState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - sizeDeltaState = 0_pInt - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = 0_pInt - plasticState(phase)%nSlip = 0_pInt - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans = 0_pInt - allocate(plasticState(phase)%aTolState (sizeState)) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase)) - allocate(plasticState(phase)%state (sizeState,NofMyPhase)) + allocate(plasticState(phase)%aTolState (0_pInt)) + allocate(plasticState(phase)%state0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%partionedState0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%subState0 (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%state (0_pInt,NofMyPhase)) - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase)) + allocate(plasticState(phase)%dotState (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%deltaState (0_pInt,NofMyPhase)) if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase)) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%previousDotState (0_pInt,NofMyPhase)) + allocate(plasticState(phase)%previousDotState2(0_pInt,NofMyPhase)) endif if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RK4dotState (0_pInt,NofMyPhase)) if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase)) + allocate(plasticState(phase)%RKCK45dotState (6,0_pInt,NofMyPhase)) endif enddo initializeInstances - allocate(plastic_none_sizePostResults(maxNinstance), source=0_pInt) - end subroutine plastic_none_init end module plastic_none diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 41666a34c..e1355da8f 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -2382,8 +2382,7 @@ use, intrinsic :: & use prec, only: dNeq0, & dNeq, & dEq0 -use numerics, only: numerics_integrationMode, & - numerics_timeSyncing +use numerics, only: numerics_timeSyncing use IO, only: IO_error use debug, only: debug_level, & debug_constitutive, & @@ -2942,14 +2941,12 @@ rhoDot = rhoDotFlux & + rhoDotAthermalAnnihilation & + rhoDotThermalAnnihilation -if (numerics_integrationMode == 1_pInt) then ! save rates for output if in central integration mode - rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) - rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) - rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) - rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) - rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) - rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) -endif +rhoDotFluxOutput(1:ns,1:8,1_pInt,ip,el) = rhoDotFlux(1:ns,1:8) +rhoDotMultiplicationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotMultiplication(1:ns,[1,3]) +rhoDotSingle2DipoleGlideOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotSingle2DipoleGlide(1:ns,9:10) +rhoDotAthermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotAthermalAnnihilation(1:ns,9:10) +rhoDotThermalAnnihilationOutput(1:ns,1:2,1_pInt,ip,el) = rhoDotThermalAnnihilation(1:ns,9:10) +rhoDotEdgeJogsOutput(1:ns,1_pInt,ip,el) = 2.0_pReal * rhoDotThermalAnnihilation(1:ns,1) #ifdef DEBUG diff --git a/src/plastic_phenopowerlaw.f90 b/src/plastic_phenopowerlaw.f90 index 8a6d8b145..59a106435 100644 --- a/src/plastic_phenopowerlaw.f90 +++ b/src/plastic_phenopowerlaw.f90 @@ -1,5 +1,7 @@ +!-------------------------------------------------------------------------------------------------- !> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH !> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH +!> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw !! fitting !-------------------------------------------------------------------------------------------------- @@ -10,91 +12,75 @@ module plastic_phenopowerlaw implicit none private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenopowerlaw_sizePostResults !< cumulative size of post results - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_phenopowerlaw_sizePostResult !< size of each post result output - + plastic_phenopowerlaw_sizePostResult !< size of each post result output character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_phenopowerlaw_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_phenopowerlaw_Noutput !< number of outputs per instance of this constitution - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenopowerlaw_totalNslip, & !< no. of slip system used in simulation - plastic_phenopowerlaw_totalNtwin, & !< no. of twin system used in simulation - plastic_phenopowerlaw_totalNtrans !< no. of trans system used in simulation - - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntwin, & !< active number of twin systems per family (input parameter, per family) - plastic_phenopowerlaw_Ntrans !< active number of trans systems per family (input parameter, per family) - - real(pReal), dimension(:), allocatable, private :: & - plastic_phenopowerlaw_gdot0_slip, & !< reference shear strain rate for slip (input parameter) - plastic_phenopowerlaw_gdot0_twin, & !< reference shear strain rate for twin (input parameter) - plastic_phenopowerlaw_n_slip, & !< stress exponent for slip (input parameter) - plastic_phenopowerlaw_n_twin, & !< stress exponent for twin (input parameter) - plastic_phenopowerlaw_spr, & !< push-up factor for slip saturation due to twinning - plastic_phenopowerlaw_twinB, & - plastic_phenopowerlaw_twinC, & - plastic_phenopowerlaw_twinD, & - plastic_phenopowerlaw_twinE, & - plastic_phenopowerlaw_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) - plastic_phenopowerlaw_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) - plastic_phenopowerlaw_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) - plastic_phenopowerlaw_a_slip, & - plastic_phenopowerlaw_aTolResistance, & - plastic_phenopowerlaw_aTolShear, & - plastic_phenopowerlaw_aTolTwinfrac, & - plastic_phenopowerlaw_aTolTransfrac, & - plastic_phenopowerlaw_Cnuc, & !< coefficient for strain-induced martensite nucleation - plastic_phenopowerlaw_Cdwp, & !< coefficient for double well potential - plastic_phenopowerlaw_Cgro, & !< coefficient for stress-assisted martensite growth - plastic_phenopowerlaw_deltaG !< free energy difference between austensite and martensite [MPa] - - real(pReal), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) - plastic_phenopowerlaw_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) - plastic_phenopowerlaw_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) - plastic_phenopowerlaw_H_int, & !< per family hardening activity(input parameter(optional), per family) - plastic_phenopowerlaw_nonSchmidCoeff, & - - plastic_phenopowerlaw_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - plastic_phenopowerlaw_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - plastic_phenopowerlaw_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - plastic_phenopowerlaw_interaction_TwinTwin !< interaction factors twin - twin (input parameter) - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_phenopowerlaw_hardeningMatrix_SlipSlip, & - plastic_phenopowerlaw_hardeningMatrix_SlipTwin, & - plastic_phenopowerlaw_hardeningMatrix_TwinSlip, & - plastic_phenopowerlaw_hardeningMatrix_TwinTwin + plastic_phenopowerlaw_output !< name of each post result output enum, bind(c) - enumerator :: undefined_ID, & - resistance_slip_ID, & - accumulatedshear_slip_ID, & - shearrate_slip_ID, & - resolvedstress_slip_ID, & - totalshear_ID, & - resistance_twin_ID, & - accumulatedshear_twin_ID, & - shearrate_twin_ID, & - resolvedstress_twin_ID, & - totalvolfrac_twin_ID + enumerator :: & + undefined_ID, & + resistance_slip_ID, & + accumulatedshear_slip_ID, & + shearrate_slip_ID, & + resolvedstress_slip_ID, & + totalshear_ID, & + resistance_twin_ID, & + accumulatedshear_twin_ID, & + shearrate_twin_ID, & + resolvedstress_twin_ID, & + totalvolfrac_twin_ID end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_phenopowerlaw_outputID !< ID of each post result output + + type, private :: tParameters !< container type for internal constitutive parameters + integer(pInt) :: & + totalNslip, & + totalNtwin + real(pReal) :: & + gdot0_slip, & !< reference shear strain rate for slip + gdot0_twin, & !< reference shear strain rate for twin + n_slip, & !< stress exponent for slip + n_twin, & !< stress exponent for twin + spr, & !< push-up factor for slip saturation due to twinning + twinB, & + twinC, & + twinD, & + twinE, & + h0_SlipSlip, & !< reference hardening slip - slip + h0_TwinSlip, & !< reference hardening twin - slip + h0_TwinTwin, & !< reference hardening twin - twin + a_slip, & + aTolResistance, & ! default absolute tolerance 1 Pa + aTolShear, & ! default absolute tolerance 1e-6 + aTolTwinfrac ! default absolute tolerance 1e-6 + integer(pInt), dimension(:), allocatable :: & + Nslip, & !< active number of slip systems per family + Ntwin !< active number of twin systems per family + real(pReal), dimension(:), allocatable :: & + tau0_slip, & !< initial critical shear stress for slip + tau0_twin, & !< initial critical shear stress for twin + tausat_slip, & !< maximum critical shear stress for slip + nonSchmidCoeff, & + H_int !< per family hardening activity (optional) + real(pReal), dimension(:,:), allocatable :: & + interaction_SlipSlip, & !< slip resistance from slip activity + interaction_SlipTwin, & !< slip resistance from twin activity + interaction_TwinSlip, & !< twin resistance from slip activity + interaction_TwinTwin !< twin resistance from twin activity + + integer(kind(undefined_ID)), dimension(:), allocatable :: & + outputID !< ID of each post result output + end type + + type(tParameters), dimension(:), allocatable, private :: param !< containers of constitutive parameters (len Ninstance) type, private :: tPhenopowerlawState real(pReal), pointer, dimension(:,:) :: & s_slip, & s_twin, & accshear_slip, & - accshear_twin + accshear_twin, & + whole real(pReal), pointer, dimension(:) :: & sumGamma, & sumF @@ -102,18 +88,13 @@ module plastic_phenopowerlaw type(tPhenopowerlawState), allocatable, dimension(:), private :: & dotState, & - state, & - state0 + state public :: & plastic_phenopowerlaw_init, & plastic_phenopowerlaw_LpAndItsTangent, & plastic_phenopowerlaw_dotState, & plastic_phenopowerlaw_postResults - private :: & - plastic_phenopowerlaw_aTolState, & - plastic_phenopowerlaw_stateInit - contains @@ -122,7 +103,7 @@ contains !> @brief module initialization !> @details reads in material parameters, allocates arrays, and does sanity checks !-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_init(fileUnit) +subroutine plastic_phenopowerlaw_init #if defined(__GFORTRAN__) || __INTEL_COMPILER >= 1800 use, intrinsic :: iso_fortran_env, only: & compiler_version, & @@ -136,20 +117,12 @@ subroutine plastic_phenopowerlaw_init(fileUnit) debug_levelBasic use math, only: & math_Mandel3333to66, & - math_Voigt66to3333 + math_Voigt66to3333, & + math_expand use IO, only: & - IO_read, & - IO_lc, & - IO_getTag, & - IO_isBlank, & - IO_stringPos, & - IO_stringValue, & - IO_floatValue, & - IO_intValue, & IO_warning, & IO_error, & - IO_timeStamp, & - IO_EOF + IO_timeStamp use material, only: & phase_plasticity, & phase_plasticityInstance, & @@ -159,615 +132,338 @@ subroutine plastic_phenopowerlaw_init(fileUnit) material_phase, & plasticState use config, only: & - MATERIAL_partPhase + MATERIAL_partPhase, & + config_phase use lattice use numerics,only: & numerics_integrator implicit none - integer(pInt), intent(in) :: fileUnit - integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: & maxNinstance, & - instance,phase,j,k, f,o, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, & - Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & - Nchunks_TransFamilies = 0_pInt, Nchunks_nonSchmid = 0_pInt, & - NipcMyPhase, & - offset_slip, index_myFamily, index_otherFamily, & - mySize=0_pInt,sizeState,sizeDotState, sizeDeltaState, & + instance,p,j,k, f,o, i,& + NipcMyPhase, outputSize, & + index_myFamily, index_otherFamily, & + sizeState,sizeDotState, & startIndex, endIndex - character(len=65536) :: & - tag = '', & - line = '' - real(pReal), dimension(:), allocatable :: tempPerSlip + + real(pReal), dimension(:,:), allocatable :: temp1, temp2 + + integer(pInt), dimension(0), parameter :: emptyIntArray = [integer(pInt)::] + real(pReal), dimension(0), parameter :: emptyRealArray = [real(pReal)::] + character(len=65536), dimension(0), parameter :: emptyStringArray = [character(len=65536)::] + + type(tParameters) :: prm + + integer(kind(undefined_ID)) :: & + outputID !< ID of each post result output + + character(len=512) :: & + extmsg = '' + character(len=65536), dimension(:), allocatable :: outputs write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPOWERLAW_label//' init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID),pInt) - if (maxNinstance == 0_pInt) return - if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt) & write(6,'(a16,1x,i5,/)') '# instances:',maxNinstance - - allocate(plastic_phenopowerlaw_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance), & - source=0_pInt) + allocate(plastic_phenopowerlaw_sizePostResult(maxval(phase_Noutput),maxNinstance),source=0_pInt) allocate(plastic_phenopowerlaw_output(maxval(phase_Noutput),maxNinstance)) - plastic_phenopowerlaw_output = '' - allocate(plastic_phenopowerlaw_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(plastic_phenopowerlaw_Noutput(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_Ntrans(lattice_maxNtransFamily,maxNinstance),source=0_pInt) - allocate(plastic_phenopowerlaw_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_totalNtrans(maxNinstance), source=0_pInt) - allocate(plastic_phenopowerlaw_gdot0_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_n_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_tau0_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_tausat_slip(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_H_int(lattice_maxNslipFamily,maxNinstance),source=0.0_pReal) - allocate(plastic_phenopowerlaw_gdot0_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_n_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_tau0_twin(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_spr(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinB(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinC(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinD(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_twinE(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_SlipSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_TwinSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_h0_TwinTwin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_a_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolResistance(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolShear(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolTwinfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_aTolTransfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cnuc(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cdwp(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_Cgro(maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_deltaG(maxNinstance), source=0.0_pReal) + plastic_phenopowerlaw_output = '' - rewind(fileUnit) - phase = 0_pInt - do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= material_partPhase) ! wind forward to - line = IO_read(fileUnit) - enddo - - parsingFile: do while (trim(line) /= IO_EOF) ! read through sections of phase part - line = IO_read(fileUnit) - if (IO_isBlank(line)) cycle ! skip empty lines - if (IO_getTag(line,'<','>') /= '') then ! stop at next part - line = IO_read(fileUnit, .true.) ! reset IO_read - exit - endif - if (IO_getTag(line,'[',']') /= '') then ! next phase - phase = phase + 1_pInt ! advance phase section counter - if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) ! maximum number of slip families according to lattice type of current phase - Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) ! maximum number of twin families according to lattice type of current phase - Nchunks_TransFamilies = count(lattice_NtransSystem(:,phase) > 0_pInt) ! maximum number of trans families according to lattice type of current phase - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) - Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) - Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) - Nchunks_nonSchmid = lattice_NnonSchmid(phase) - if(allocated(tempPerSlip)) deallocate(tempPerSlip) - allocate(tempPerSlip(Nchunks_SlipFamilies)) - endif - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_PHENOPOWERLAW_ID) then ! one of my phases. Do not short-circuit here (.and. between if-statements), it's not safe in Fortran - instance = phase_plasticityInstance(phase) ! which instance of my plasticity is present phase - chunkPos = IO_stringPos(line) - tag = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ! extract key - select case(tag) - case ('(output)') - select case(IO_lc(IO_stringValue(line,chunkPos,2_pInt))) - case ('resistance_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_slip') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_slip_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('totalshear') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalshear_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resistance_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = accumulatedshear_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = shearrate_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = resolvedstress_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('totalvolfrac_twin') - plastic_phenopowerlaw_Noutput(instance) = plastic_phenopowerlaw_Noutput(instance) + 1_pInt - plastic_phenopowerlaw_outputID(plastic_phenopowerlaw_Noutput(instance),instance) = totalvolfrac_twin_ID - plastic_phenopowerlaw_output(plastic_phenopowerlaw_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case default - - end select -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of slip families - case ('nslip') - if (chunkPos(1) < Nchunks_SlipFamilies + 1_pInt) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_SlipFamilies = chunkPos(1) - 1_pInt ! user specified number of (possibly) active slip families (e.g. 6 0 6 --> 3) - do j = 1_pInt, Nchunks_SlipFamilies - plastic_phenopowerlaw_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('tausat_slip','tau0_slip','H_int') - tempPerSlip = 0.0_pReal - do j = 1_pInt, Nchunks_SlipFamilies - if (plastic_phenopowerlaw_Nslip(j,instance) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) - case ('tausat_slip') - plastic_phenopowerlaw_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('tau0_slip') - plastic_phenopowerlaw_tau0_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('H_int') - plastic_phenopowerlaw_H_int(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - end select -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of twin families - case ('ntwin') - if (chunkPos(1) < Nchunks_TwinFamilies + 1_pInt) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TwinFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TwinFamilies - plastic_phenopowerlaw_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0_twin') - do j = 1_pInt, Nchunks_TwinFamilies - if (plastic_phenopowerlaw_Ntwin(j,instance) > 0_pInt) & - plastic_phenopowerlaw_tau0_twin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of transformation families - case ('ntrans') - if (chunkPos(1) < Nchunks_TransFamilies + 1_pInt) & - call IO_warning(53_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - Nchunks_TransFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TransFamilies - plastic_phenopowerlaw_Ntrans(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters depending on number of interactions - case ('interaction_slipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_SlipSlip - plastic_phenopowerlaw_interaction_SlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_sliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_SlipTwin - plastic_phenopowerlaw_interaction_SlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_TwinSlip - plastic_phenopowerlaw_interaction_TwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt, Nchunks_TwinTwin - plastic_phenopowerlaw_interaction_TwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('nonschmid_coefficients') - if (chunkPos(1) < 1_pInt + Nchunks_nonSchmid) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPOWERLAW_label//')') - do j = 1_pInt,Nchunks_nonSchmid - plastic_phenopowerlaw_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - case ('gdot0_slip') - plastic_phenopowerlaw_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('n_slip') - plastic_phenopowerlaw_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_slip', 'w0_slip') - plastic_phenopowerlaw_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('gdot0_twin') - plastic_phenopowerlaw_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('n_twin') - plastic_phenopowerlaw_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('s_pr') - plastic_phenopowerlaw_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_b') - plastic_phenopowerlaw_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_c') - plastic_phenopowerlaw_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_d') - plastic_phenopowerlaw_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_e') - plastic_phenopowerlaw_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_slipslip') - plastic_phenopowerlaw_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twinslip') - plastic_phenopowerlaw_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twintwin') - plastic_phenopowerlaw_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_resistance') - plastic_phenopowerlaw_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_shear') - plastic_phenopowerlaw_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_twinfrac') - plastic_phenopowerlaw_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_transfrac') - plastic_phenopowerlaw_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cnuc') - plastic_phenopowerlaw_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cdwp') - plastic_phenopowerlaw_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cgro') - plastic_phenopowerlaw_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('deltag') - plastic_phenopowerlaw_deltaG(instance) = IO_floatValue(line,chunkPos,2_pInt) - case default - - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then - instance = phase_plasticityInstance(phase) - plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance) = & - min(lattice_NslipSystem(1:lattice_maxNslipFamily,phase),& ! limit active slip systems per family to min of available and requested - plastic_phenopowerlaw_Nslip(1:lattice_maxNslipFamily,instance)) - plastic_phenopowerlaw_Ntwin(1:lattice_maxNtwinFamily,instance) = & - min(lattice_NtwinSystem(1:lattice_maxNtwinFamily,phase),& ! limit active twin systems per family to min of available and requested - plastic_phenopowerlaw_Ntwin(:,instance)) - plastic_phenopowerlaw_totalNslip(instance) = sum(plastic_phenopowerlaw_Nslip(:,instance)) ! how many slip systems altogether - plastic_phenopowerlaw_totalNtwin(instance) = sum(plastic_phenopowerlaw_Ntwin(:,instance)) ! how many twin systems altogether - plastic_phenopowerlaw_totalNtrans(instance) = sum(plastic_phenopowerlaw_Ntrans(:,instance)) ! how many trans systems altogether - - if (any(plastic_phenopowerlaw_tau0_slip(:,instance) < 0.0_pReal .and. & - plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_gdot0_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_n_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(plastic_phenopowerlaw_tausat_slip(:,instance) <= 0.0_pReal .and. & - plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(dEq0(plastic_phenopowerlaw_a_slip(instance)) .and. plastic_phenopowerlaw_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (any(plastic_phenopowerlaw_tau0_twin(:,instance) < 0.0_pReal .and. & - plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( plastic_phenopowerlaw_gdot0_twin(instance) <= 0.0_pReal .and. & - any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if ( plastic_phenopowerlaw_n_twin(instance) <= 0.0_pReal .and. & - any(plastic_phenopowerlaw_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPOWERLAW_label//')') - if (plastic_phenopowerlaw_aTolResistance(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa - if (plastic_phenopowerlaw_aTolShear(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenopowerlaw_aTolTwinfrac(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenopowerlaw_aTolTransfrac(instance) <= 0.0_pReal) & - plastic_phenopowerlaw_aTolTransfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - endif myPhase - enddo sanityChecks - -!-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - allocate(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from slip activity - maxval(plastic_phenopowerlaw_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(maxval(plastic_phenopowerlaw_totalNslip),& ! slip resistance from twin activity - maxval(plastic_phenopowerlaw_totalNtwin),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from slip activity - maxval(plastic_phenopowerlaw_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(maxval(plastic_phenopowerlaw_totalNtwin),& ! twin resistance from twin activity - maxval(plastic_phenopowerlaw_totalNtwin),& - maxNinstance), source=0.0_pReal) + allocate(param(maxNinstance)) ! one container of parameters per instance allocate(state(maxNinstance)) - allocate(state0(maxNinstance)) allocate(dotState(maxNinstance)) - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config - myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenopowerlaw_ID) then ! only consider my phase - NipcMyPhase = count(material_phase == phase) ! number of IPCs containing my phase - instance = phase_plasticityInstance(phase) ! which instance of my phase + do p = 1_pInt, size(phase_plasticityInstance) + if (phase_plasticity(p) /= PLASTICITY_PHENOPOWERLAW_ID) cycle + instance = phase_plasticityInstance(p) + associate(prm => param(instance)) -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) - select case(plastic_phenopowerlaw_outputID(o,instance)) - case(resistance_slip_ID, & - shearrate_slip_ID, & - accumulatedshear_slip_ID, & - resolvedstress_slip_ID & - ) - mySize = plastic_phenopowerlaw_totalNslip(instance) - case(resistance_twin_ID, & - shearrate_twin_ID, & - accumulatedshear_twin_ID, & - resolvedstress_twin_ID & - ) - mySize = plastic_phenopowerlaw_totalNtwin(instance) - case(totalshear_ID, & - totalvolfrac_twin_ID & - ) - mySize = 1_pInt - case default - end select + prm%Nslip = config_phase(p)%getInts('nslip',defaultVal=emptyIntArray) + if (size(prm%Nslip) > count(lattice_NslipSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + if (any(lattice_NslipSystem(1:size(prm%Nslip),p)-prm%Nslip < 0_pInt)) call IO_error(150_pInt,ext_msg='Nslip') + prm%totalNslip = sum(prm%Nslip) + + if (prm%totalNslip > 0_pInt) then + prm%tau0_slip = config_phase(p)%getFloats('tau0_slip') + prm%tausat_slip = config_phase(p)%getFloats('tausat_slip') + prm%interaction_SlipSlip = spread(config_phase(p)%getFloats('interaction_slipslip'),2,1) + prm%H_int = config_phase(p)%getFloats('h_int',& + defaultVal=[(0.0_pReal,i=1_pInt,size(prm%Nslip))]) + prm%nonSchmidCoeff = config_phase(p)%getFloats('nonschmid_coefficients',& + defaultVal = emptyRealArray ) + + prm%gdot0_slip = config_phase(p)%getFloat('gdot0_slip') + prm%n_slip = config_phase(p)%getFloat('n_slip') + prm%a_slip = config_phase(p)%getFloat('a_slip') + prm%h0_SlipSlip = config_phase(p)%getFloat('h0_slipslip') + endif + + prm%Ntwin = config_phase(p)%getInts('ntwin', defaultVal=emptyIntArray) + if (size(prm%Ntwin) > count(lattice_NtwinSystem(:,p) > 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + if (any(lattice_NtwinSystem(1:size(prm%Ntwin),p)-prm%Ntwin < 0_pInt)) call IO_error(150_pInt,ext_msg='Ntwin') + prm%totalNtwin = sum(prm%Ntwin) + + if (prm%totalNtwin > 0_pInt) then + prm%tau0_twin = config_phase(p)%getFloats('tau0_twin') + prm%interaction_TwinTwin = spread(config_phase(p)%getFloats('interaction_twintwin'),2,1) + + prm%gdot0_twin = config_phase(p)%getFloat('gdot0_twin') + prm%n_twin = config_phase(p)%getFloat('n_twin') + prm%spr = config_phase(p)%getFloat('s_pr') + prm%twinB = config_phase(p)%getFloat('twin_b') + prm%twinC = config_phase(p)%getFloat('twin_c') + prm%twinD = config_phase(p)%getFloat('twin_d') + prm%twinE = config_phase(p)%getFloat('twin_e') + prm%h0_TwinTwin = config_phase(p)%getFloat('h0_twintwin') + endif + + if (prm%totalNslip > 0_pInt .and. prm%totalNtwin > 0_pInt) then + prm%interaction_SlipTwin = spread(config_phase(p)%getFloats('interaction_sliptwin'),2,1) + prm%interaction_TwinSlip = spread(config_phase(p)%getFloats('interaction_twinslip'),2,1) + prm%h0_TwinSlip = config_phase(p)%getFloat('h0_twinslip') + endif + + + prm%aTolResistance = config_phase(p)%getFloat('atol_resistance',defaultVal=1.0_pReal) + prm%aTolShear = config_phase(p)%getFloat('atol_shear',defaultVal=1.0e-6_pReal) + prm%aTolTwinfrac = config_phase(p)%getFloat('atol_twinfrac',defaultVal=1.0e-6_pReal) + + outputs = config_phase(p)%getStrings('(output)',defaultVal=emptyStringArray) + allocate(prm%outputID(0)) + do i=1_pInt, size(outputs) + outputID = undefined_ID + select case(outputs(i)) + case ('resistance_slip') + outputID = resistance_slip_ID + outputSize = prm%totalNslip + case ('accumulatedshear_slip') + outputID = accumulatedshear_slip_ID + outputSize = prm%totalNslip + case ('shearrate_slip') + outputID = shearrate_slip_ID + outputSize = prm%totalNslip + case ('resolvedstress_slip') + outputID = resolvedstress_slip_ID + outputSize = prm%totalNslip + + case ('resistance_twin') + outputID = resistance_twin_ID + outputSize = prm%totalNtwin + case ('accumulatedshear_twin') + outputID = accumulatedshear_twin_ID + outputSize = prm%totalNtwin + case ('shearrate_twin') + outputID = shearrate_twin_ID + outputSize = prm%totalNtwin + case ('resolvedstress_twin') + outputID = resolvedstress_twin_ID + outputSize = prm%totalNtwin + + case ('totalvolfrac_twin') + outputID = totalvolfrac_twin_ID + outputSize = 1_pInt + case ('totalshear') + outputID = totalshear_ID + outputSize = 1_pInt + end select + + if (outputID /= undefined_ID) then + plastic_phenopowerlaw_output(i,instance) = outputs(i) + plastic_phenopowerlaw_sizePostResult(i,instance) = outputSize + prm%outputID = [prm%outputID , outputID] + endif + + end do + + extmsg = '' + if (sum(prm%Nslip) > 0_pInt) then + if (size(prm%tau0_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tau0_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%tausat_slip) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(tausat_slip) ('//PLASTICITY_PHENOPOWERLAW_label//')') + if (size(prm%H_int) /= size(prm%Nslip)) call IO_error(211_pInt,ip=instance, & + ext_msg='shape(H_int) ('//PLASTICITY_PHENOPOWERLAW_label//')') + + if (any(prm%tau0_slip < 0.0_pReal .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_slip " + if (any(prm%tausat_slip < prm%tau0_slip .and. prm%Nslip > 0_pInt)) & + extmsg = trim(extmsg)//"tausat_slip " + + if (prm%gdot0_slip <= 0.0_pReal) extmsg = trim(extmsg)//" gdot0_slip " + if (dEq0(prm%a_slip)) extmsg = trim(extmsg)//" a_slip " ! ToDo: negative values ok? + if (dEq0(prm%n_slip)) extmsg = trim(extmsg)//" n_slip " ! ToDo: negative values ok? + endif + + if (sum(prm%Ntwin) > 0_pInt) then + if (size(prm%tau0_twin) /= size(prm%ntwin)) call IO_error(211_pInt,ip=instance,& + ext_msg='shape(tau0_twin) ('//PLASTICITY_PHENOPOWERLAW_label//')') + + if (any(prm%tau0_twin < 0.0_pReal .and. prm%Ntwin > 0_pInt)) & + extmsg = trim(extmsg)//"tau0_twin " + + if (prm%gdot0_twin <= 0.0_pReal) extmsg = trim(extmsg)//"gdot0_twin " + if (dEq0(prm%n_twin)) extmsg = trim(extmsg)//"n_twin " ! ToDo: negative values ok? + endif + + if (prm%aTolResistance <= 0.0_pReal) extmsg = trim(extmsg)//"aTolresistance " + if (prm%aTolShear <= 0.0_pReal) extmsg = trim(extmsg)//"aTolShear " + if (prm%aTolTwinfrac <= 0.0_pReal) extmsg = trim(extmsg)//"atoltwinfrac " + + if (extmsg /= '') call IO_error(211_pInt,ip=instance,& + ext_msg=trim(extmsg)//'('//PLASTICITY_PHENOPOWERLAW_label//')') - outputFound: if (mySize > 0_pInt) then - plastic_phenopowerlaw_sizePostResult(o,instance) = mySize - plastic_phenopowerlaw_sizePostResults(instance) = plastic_phenopowerlaw_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop !-------------------------------------------------------------------------------------------------- ! allocate state arrays - sizeState = plastic_phenopowerlaw_totalNslip(instance) & ! s_slip - + plastic_phenopowerlaw_totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenopowerlaw_totalNslip(instance) & ! accshear_slip - + plastic_phenopowerlaw_totalNtwin(instance) ! accshear_twin + NipcMyPhase = count(material_phase == p) ! number of IPCs containing my phase + sizeState = size(['tau_slip ','accshear_slip']) * prm%TotalNslip & + + size(['tau_twin ','accshear_twin']) * prm%TotalNtwin & + + size(['sum(gamma)', 'sum(f) ']) - sizeDotState = sizeState - sizeDeltaState = 0_pInt - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_phenopowerlaw_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_phenopowerlaw_totalNslip(instance) - plasticState(phase)%nTwin =plastic_phenopowerlaw_totalNtwin(instance) - plasticState(phase)%nTrans=plastic_phenopowerlaw_totalNtrans(instance) - allocate(plasticState(phase)%aTolState ( sizeState), source=0.0_pReal) - allocate(plasticState(phase)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) + sizeDotState = sizeState + plasticState(p)%sizeState = sizeState + plasticState(p)%sizeDotState = sizeDotState + plasticState(p)%sizePostResults = sum(plastic_phenopowerlaw_sizePostResult(:,instance)) + plasticState(p)%nSlip = sum(prm%Nslip) + plasticState(p)%nTwin = sum(prm%Ntwin) + allocate(plasticState(p)%aTolState ( sizeState), source=0.0_pReal) + allocate(plasticState(p)%state0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%partionedState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%subState0 ( sizeState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%state ( sizeState,NipcMyPhase), source=0.0_pReal) - offset_slip = plasticState(phase)%nSlip+plasticState(phase)%nTwin+2_pInt - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NipcMyPhase) - - do f = 1_pInt,lattice_maxNslipFamily ! >>> interaction slip -- X - index_myFamily = sum(plastic_phenopowerlaw_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenopowerlaw_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_SlipSlip(lattice_interactionSlipSlip( & - sum(lattice_NslipSystem(1:f-1,phase))+j, & - sum(lattice_NslipSystem(1:o-1,phase))+k, & - phase), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenopowerlaw_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_SlipTwin(lattice_interactionSlipTwin( & - sum(lattice_NslipSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo - - enddo; enddo - - do f = 1_pInt,lattice_maxNtwinFamily ! >>> interaction twin -- X - index_myFamily = sum(plastic_phenopowerlaw_Ntwin(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) ! loop over (active) systems in my family (twin) - - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenopowerlaw_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenopowerlaw_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_TwinSlip(lattice_interactionTwinSlip( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NslipSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo - - do o = 1_pInt,lattice_maxNtwinFamily - index_otherFamily = sum(plastic_phenopowerlaw_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenopowerlaw_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenopowerlaw_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenopowerlaw_interaction_TwinTwin(lattice_interactionTwinTwin( & - sum(lattice_NtwinSystem(1:f-1_pInt,phase))+j, & - sum(lattice_NtwinSystem(1:o-1_pInt,phase))+k, & - phase), instance ) - enddo; enddo - - enddo; enddo - startIndex = 1_pInt - endIndex = plastic_phenopowerlaw_totalNslip(instance) - state (instance)%s_slip=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%s_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) - dotState(instance)%s_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - - startIndex = endIndex + 1_pInt - endIndex = endIndex + plastic_phenopowerlaw_totalNtwin(instance) - state (instance)%s_twin=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%s_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) - dotState(instance)%s_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) - - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumGamma=>plasticState(phase)%state (startIndex,:) - state0 (instance)%sumGamma=>plasticState(phase)%state0 (startIndex,:) - dotState(instance)%sumGamma=>plasticState(phase)%dotState(startIndex,:) - - startIndex = endIndex + 1_pInt - endIndex = endIndex + 1_pInt - state (instance)%sumF=>plasticState(phase)%state (startIndex,:) - state0 (instance)%sumF=>plasticState(phase)%state0 (startIndex,:) - dotState(instance)%sumF=>plasticState(phase)%dotState(startIndex,:) - - startIndex = endIndex + 1_pInt - endIndex = endIndex +plastic_phenopowerlaw_totalNslip(instance) - state (instance)%accshear_slip=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%accshear_slip=>plasticState(phase)%state0 (startIndex:endIndex,:) - dotState(instance)%accshear_slip=>plasticState(phase)%dotState(startIndex:endIndex,:) - - startIndex = endIndex + 1_pInt - endIndex = endIndex +plastic_phenopowerlaw_totalNtwin(instance) - state (instance)%accshear_twin=>plasticState(phase)%state (startIndex:endIndex,:) - state0 (instance)%accshear_twin=>plasticState(phase)%state0 (startIndex:endIndex,:) - dotState(instance)%accshear_twin=>plasticState(phase)%dotState(startIndex:endIndex,:) + allocate(plasticState(p)%dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + allocate(plasticState(p)%deltaState (0_pInt,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 1_pInt)) then + allocate(plasticState(p)%previousDotState (sizeDotState,NipcMyPhase),source=0.0_pReal) + allocate(plasticState(p)%previousDotState2(sizeDotState,NipcMyPhase),source=0.0_pReal) + endif + if (any(numerics_integrator == 4_pInt)) & + allocate(plasticState(p)%RK4dotState (sizeDotState,NipcMyPhase), source=0.0_pReal) + if (any(numerics_integrator == 5_pInt)) & + allocate(plasticState(p)%RKCK45dotState (6,sizeDotState,NipcMyPhase), source=0.0_pReal) - call plastic_phenopowerlaw_stateInit(phase,instance) - call plastic_phenopowerlaw_aTolState(phase,instance) - endif myPhase2 - enddo initializeInstances +!-------------------------------------------------------------------------------------------------- +! calculate hardening matrices + allocate(temp1(sum(prm%Nslip),sum(prm%Nslip)),source =0.0_pReal) + allocate(temp2(sum(prm%Nslip),sum(prm%Ntwin)),source =0.0_pReal) + mySlipFamilies: do f = 1_pInt,size(prm%Nslip,1) ! >>> interaction slip -- X + index_myFamily = sum(prm%Nslip(1:f-1_pInt)) + + mySlipSystems: do j = 1_pInt,prm%Nslip(f) + otherSlipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + otherSlipSystems: do k = 1_pInt,prm%Nslip(o) + temp1(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipSlip(lattice_interactionSlipSlip( & + sum(lattice_NslipSystem(1:f-1,p))+j, & + sum(lattice_NslipSystem(1:o-1,p))+k, & + p),1) + enddo otherSlipSystems; enddo otherSlipFamilies + + twinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + twinSystems: do k = 1_pInt,prm%Ntwin(o) + temp2(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_SlipTwin(lattice_interactionSlipTwin( & + sum(lattice_NslipSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p),1) + enddo twinSystems; enddo twinFamilies + enddo mySlipSystems + enddo mySlipFamilies + prm%interaction_SlipSlip = temp1; deallocate(temp1) + prm%interaction_SlipTwin = temp2; deallocate(temp2) + + + allocate(temp1(sum(prm%Ntwin),sum(prm%Nslip)),source =0.0_pReal) + allocate(temp2(sum(prm%Ntwin),sum(prm%Ntwin)),source =0.0_pReal) + myTwinFamilies: do f = 1_pInt,size(prm%Ntwin,1) ! >>> interaction twin -- X + index_myFamily = sum(prm%Ntwin(1:f-1_pInt)) + myTwinSystems: do j = 1_pInt,prm%Ntwin(f) + slipFamilies: do o = 1_pInt,size(prm%Nslip,1) + index_otherFamily = sum(prm%Nslip(1:o-1_pInt)) + slipSystems: do k = 1_pInt,prm%Nslip(o) + temp1(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinSlip(lattice_interactionTwinSlip( & + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NslipSystem(1:o-1_pInt,p))+k, & + p),1) + enddo slipSystems; enddo slipFamilies + + otherTwinFamilies: do o = 1_pInt,size(prm%Ntwin,1) + index_otherFamily = sum(prm%Ntwin(1:o-1_pInt)) + otherTwinSystems: do k = 1_pInt,prm%Ntwin(o) + temp2(index_myFamily+j,index_otherFamily+k) = & + prm%interaction_TwinTwin(lattice_interactionTwinTwin( & + sum(lattice_NtwinSystem(1:f-1_pInt,p))+j, & + sum(lattice_NtwinSystem(1:o-1_pInt,p))+k, & + p),1) + enddo otherTwinSystems; enddo otherTwinFamilies + enddo myTwinSystems + enddo myTwinFamilies + prm%interaction_TwinSlip = temp1; deallocate(temp1) + prm%interaction_TwinTwin = temp2; deallocate(temp2) + +!-------------------------------------------------------------------------------------------------- +! locally defined state aliases and initialization of state0 and aTolState + startIndex = 1_pInt + endIndex = plasticState(p)%nSlip + state (instance)%s_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & + spread(math_expand(prm%tau0_slip, prm%Nslip), 2, NipcMyPhase) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance + + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%s_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%s_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%state0(startIndex:endIndex,:) = & + spread(math_expand(prm%tau0_twin, prm%Ntwin), 2, NipcMyPhase) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolResistance + + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumGamma=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumGamma=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + + startIndex = endIndex + 1_pInt + endIndex = endIndex + 1_pInt + state (instance)%sumF=>plasticState(p)%state (startIndex,:) + dotState(instance)%sumF=>plasticState(p)%dotState(startIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolTwinFrac + + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nSlip + state (instance)%accshear_slip=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_slip=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + ! global alias + plasticState(p)%slipRate =>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%accumulatedSlip =>plasticState(p)%state(startIndex:endIndex,:) + + startIndex = endIndex + 1_pInt + endIndex = endIndex + plasticState(p)%nTwin + state (instance)%accshear_twin=>plasticState(p)%state (startIndex:endIndex,:) + dotState(instance)%accshear_twin=>plasticState(p)%dotState(startIndex:endIndex,:) + plasticState(p)%aTolState(startIndex:endIndex) = prm%aTolShear + + dotState(instance)%whole =>plasticState(p)%dotState + + end associate + enddo end subroutine plastic_phenopowerlaw_init -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_stateInit(ph,instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - integer(pInt) :: & - i - real(pReal), dimension(plasticState(ph)%sizeState) :: & - tempState - - tempState = 0.0_pReal - do i = 1_pInt,lattice_maxNslipFamily - tempState(1+sum(plastic_phenopowerlaw_Nslip(1:i-1,instance)) : & - sum(plastic_phenopowerlaw_Nslip(1:i ,instance))) = & - plastic_phenopowerlaw_tau0_slip(i,instance) - enddo - - do i = 1_pInt,lattice_maxNtwinFamily - tempState(1+sum(plastic_phenopowerlaw_Nslip(:,instance))+& - sum(plastic_phenopowerlaw_Ntwin(1:i-1,instance)) : & - sum(plastic_phenopowerlaw_Nslip(:,instance))+& - sum(plastic_phenopowerlaw_Ntwin(1:i ,instance))) = & - plastic_phenopowerlaw_tau0_twin(i,instance) - enddo - - plasticState(ph)%state0(:,:) = spread(tempState, & ! spread single tempstate array - 2, & ! along dimension 2 - size(plasticState(ph)%state0(1,:))) ! number of copies (number of IPCs) - -end subroutine plastic_phenopowerlaw_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenopowerlaw_aTolState(ph,instance) - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: & - instance, & !< number specifying the instance of the plasticity - ph - - plasticState(ph)%aTolState(1:plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolResistance(instance) - plasticState(ph)%aTolState(1+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolShear(instance) - plasticState(ph)%aTolState(2+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance)) = & - plastic_phenopowerlaw_aTolTwinFrac(instance) - plasticState(ph)%aTolState(3+plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance): & - 2+2*(plastic_phenopowerlaw_totalNslip(instance)+ & - plastic_phenopowerlaw_totalNtwin(instance))) = & - plastic_phenopowerlaw_aTolShear(instance) - -end subroutine plastic_phenopowerlaw_aTolState - - !-------------------------------------------------------------------------------------------------- !> @brief calculates plastic velocity gradient and its tangent !-------------------------------------------------------------------------------------------------- @@ -782,13 +478,11 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, lattice_Sslip_v, & lattice_Stwin, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid + lattice_NtwinSystem use material, only: & - phaseAt, phasememberAt, & + phasememberAt, & + material_phase, & phase_plasticityInstance implicit none @@ -805,7 +499,6 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation integer(pInt) :: & - instance, & index_myFamily, & f,i,j,k,l,m,n, & of, & @@ -819,10 +512,13 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor real(pReal), dimension(3,3,2) :: & nonSchmid_tensor + type(tParameters) :: prm + type(tPhenopowerlawState) :: stt of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + ph = material_phase(ipc,ip,el) + + associate(prm => param(phase_plasticityInstance(ph)), stt => state(phase_plasticityInstance(ph))) Lp = 0.0_pReal dLp_dTstar3333 = 0.0_pReal @@ -831,9 +527,9 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Slip part j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt ! Calculation of Lp @@ -841,38 +537,36 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, tau_slip_neg = tau_slip_pos nonSchmid_tensor(1:3,1:3,1) = lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,1) - do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + nonSchmid_tensor(1:3,1:3,1) = nonSchmid_tensor(1:3,1:3,1) + prm%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k,index_myFamily+i,ph) - nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)*& + nonSchmid_tensor(1:3,1:3,2) = nonSchmid_tensor(1:3,1:3,2) + prm%nonSchmidCoeff(k)*& lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) enddo - gdot_slip_pos = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & - ((abs(tau_slip_pos)/(state(instance)%s_slip(j,of))) & - **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) + gdot_slip_pos = 0.5_pReal*prm%gdot0_slip* & + ((abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_pos) - gdot_slip_neg = 0.5_pReal*plastic_phenopowerlaw_gdot0_slip(instance)* & - ((abs(tau_slip_neg)/(state(instance)%s_slip(j,of))) & - **plastic_phenopowerlaw_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) + gdot_slip_neg = 0.5_pReal*prm%gdot0_slip* & + ((abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip)*sign(1.0_pReal,tau_slip_neg) - Lp = Lp + (1.0_pReal-state(instance)%sumF(of))*& ! 1-F + Lp = Lp + (1.0_pReal-stt%sumF(of))*& (gdot_slip_pos+gdot_slip_neg)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) ! Calculation of the tangent of Lp - if (dNeq0(gdot_slip_pos)) then - dgdot_dtauslip_pos = gdot_slip_pos*plastic_phenopowerlaw_n_slip(instance)/tau_slip_pos + if (dNeq0(tau_slip_pos)) then + dgdot_dtauslip_pos = gdot_slip_pos*prm%n_slip/tau_slip_pos forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip_pos*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & nonSchmid_tensor(m,n,1) endif - if (dNeq0(gdot_slip_neg)) then - dgdot_dtauslip_neg = gdot_slip_neg*plastic_phenopowerlaw_n_slip(instance)/tau_slip_neg + if (dNeq0(tau_slip_neg)) then + dgdot_dtauslip_neg = gdot_slip_neg*prm%n_slip/tau_slip_neg forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtauslip_neg*lattice_Sslip(k,l,1,index_myFamily+i,ph)* & @@ -884,22 +578,21 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, !-------------------------------------------------------------------------------------------------- ! Twinning part j = 0_pInt - twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt ! Calculation of Lp tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin = (1.0_pReal-state(instance)%sumF(of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau_twin)/state(instance)%s_twin(j,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + gdot_twin = (1.0_pReal-stt%sumF(of))*prm%gdot0_twin*& + (abs(tau_twin)/stt%s_twin(j,of))**& + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) Lp = Lp + gdot_twin*lattice_Stwin(1:3,1:3,index_myFamily+i,ph) ! Calculation of the tangent of Lp if (dNeq0(gdot_twin)) then - dgdot_dtautwin = gdot_twin*plastic_phenopowerlaw_n_twin(instance)/tau_twin + dgdot_dtautwin = gdot_twin*prm%n_twin/tau_twin forall (k=1_pInt:3_pInt,l=1_pInt:3_pInt,m=1_pInt:3_pInt,n=1_pInt:3_pInt) & dLp_dTstar3333(k,l,m,n) = dLp_dTstar3333(k,l,m,n) + & dgdot_dtautwin*lattice_Stwin(k,l,index_myFamily+i,ph)* & @@ -910,9 +603,10 @@ subroutine plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip, dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) - + end associate end subroutine plastic_phenopowerlaw_LpAndItsTangent + !-------------------------------------------------------------------------------------------------- !> @brief calculates the rate of change of microstructure !-------------------------------------------------------------------------------------------------- @@ -920,16 +614,12 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & - lattice_shearTwin, & - lattice_NnonSchmid + lattice_shearTwin use material, only: & material_phase, & - phaseAt, phasememberAt, & - plasticState, & + phasememberAt, & phase_plasticityInstance implicit none @@ -941,142 +631,108 @@ subroutine plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) el !< element !< microstructure state integer(pInt) :: & - instance,ph, & - nSlip,nTwin, & + ph, & f,i,j,k, & - index_Gamma,index_F,index_myFamily, & - offset_accshear_slip,offset_accshear_twin, & + index_myFamily, & of real(pReal) :: & c_SlipSlip,c_TwinSlip,c_TwinTwin, & ssat_offset, & tau_slip_pos,tau_slip_neg,tau_twin - real(pReal), dimension(plastic_phenopowerlaw_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(plastic_phenopowerlaw_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNslip) :: & + gdot_slip,left_SlipSlip,right_SlipSlip + real(pReal), dimension(param(phase_plasticityInstance(material_phase(ipc,ip,el)))%totalNtwin) :: & + gdot_twin + + type(tParameters) :: prm + type(tPhenopowerlawState) :: dst,stt of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + ph = material_phase(ipc,ip,el) + associate( prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) - nSlip = plastic_phenopowerlaw_totalNslip(instance) - nTwin = plastic_phenopowerlaw_totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - offset_accshear_slip = nSlip + nTwin + 2_pInt - offset_accshear_twin = nSlip + nTwin + 2_pInt + nSlip - plasticState(ph)%dotState(:,of) = 0.0_pReal + dst%whole(:,of) = 0.0_pReal !-------------------------------------------------------------------------------------------------- ! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = plastic_phenopowerlaw_h0_SlipSlip(instance)*& - (1.0_pReal + plastic_phenopowerlaw_twinC(instance)*plasticState(ph)%state(index_F,of)**& - plastic_phenopowerlaw_twinB(instance)) - c_TwinSlip = plastic_phenopowerlaw_h0_TwinSlip(instance)*& - plasticState(ph)%state(index_Gamma,of)**plastic_phenopowerlaw_twinE(instance) - c_TwinTwin = plastic_phenopowerlaw_h0_TwinTwin(instance)*& - plasticState(ph)%state(index_F,of)**plastic_phenopowerlaw_twinD(instance) + c_SlipSlip = prm%h0_slipslip * (1.0_pReal + prm%twinC*stt%sumF(of)** prm%twinB) + c_TwinSlip = prm%h0_TwinSlip * stt%sumGamma(of)**prm%twinE + c_TwinTwin = prm%h0_TwinTwin * stt%sumF(of)**prm%twinD !-------------------------------------------------------------------------------------------------- ! calculate left and right vectors and calculate dot gammas - ssat_offset = plastic_phenopowerlaw_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) + ssat_offset = prm%spr*sqrt(stt%sumF(of)) j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies1: do f =1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal + plastic_phenopowerlaw_H_int(f,instance) ! modified no system-dependent left part - left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenopowerlaw_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenopowerlaw_tausat_slip(f,instance)+ssat_offset)) - right_TwinSlip(j) = 1.0_pReal ! no system-dependent part + left_SlipSlip(j) = 1.0_pReal + prm%H_int(f) ! modified no system-dependent left part + right_SlipSlip(j) = abs(1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) **prm%a_slip & + * sign(1.0_pReal,1.0_pReal-stt%s_slip(j,of) / (prm%tausat_slip(f)+ssat_offset)) !-------------------------------------------------------------------------------------------------- ! Calculation of dot gamma tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos - nonSchmidSystems: do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + nonSchmidSystems: do k = 1,size(prm%nonSchmidCoeff) + tau_slip_pos = tau_slip_pos + prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo nonSchmidSystems - gdot_slip(j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & - *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & - *sign(1.0_pReal,tau_slip_neg)) + gdot_slip(j) = prm%gdot0_slip*0.5_pReal* & + ( (abs(tau_slip_pos)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_pos) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip*sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 - - j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - left_TwinSlip(j) = 1.0_pReal ! no system-dependent left part - left_TwinTwin(j) = 1.0_pReal ! no system-dependent left part - right_SlipTwin(j) = 1.0_pReal ! no system-dependent right part - right_TwinTwin(j) = 1.0_pReal ! no system-dependent right part !-------------------------------------------------------------------------------------------------- ! Calculation of dot vol frac tau_twin = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - gdot_twin(j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau_twin)) + gdot_twin(j) = (1.0_pReal-stt%sumF(of))*& ! 1-F + prm%gdot0_twin*& + (abs(tau_twin)/stt%s_twin(j,of))**& + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau_twin)) enddo twinSystems1 enddo twinFamilies1 !-------------------------------------------------------------------------------------------------- ! calculate the overall hardening based on above - j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) - j = j+1_pInt - plasticState(ph)%dotState(j,of) = & ! evolution of slip resistance j - c_SlipSlip * left_SlipSlip(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & - right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(plastic_phenopowerlaw_hardeningMatrix_SlipTwin(j,1:nTwin,instance), & - right_SlipTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - plasticState(ph)%dotState(index_Gamma,of) = plasticState(ph)%dotState(index_Gamma,of) + & - abs(gdot_slip(j)) - plasticState(ph)%dotState(offset_accshear_slip+j,of) = abs(gdot_slip(j)) - enddo slipSystems2 - enddo slipFamilies2 + do j = 1_pInt,prm%totalNslip + dst%s_slip(j,of) = c_SlipSlip * left_SlipSlip(j) * & ! evolution of slip resistance j + dot_product(prm%interaction_SlipSlip(j,1:prm%totalNslip),right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + dot_product(prm%interaction_SlipTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + enddo + dst%sumGamma(of) = dst%sumGamma(of) + sum(abs(gdot_slip)) + dst%accshear_slip(1:prm%totalNslip,of) = abs(gdot_slip) j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j+1_pInt - plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j - c_TwinSlip * left_TwinSlip(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinSlip(j,1:nSlip,instance), & - right_TwinSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - c_TwinTwin * left_TwinTwin(j) * & - dot_product(plastic_phenopowerlaw_hardeningMatrix_TwinTwin(j,1:nTwin,instance), & - right_TwinTwin*gdot_twin) ! dot gamma_twin modulated by right-side twin factor - if (plasticState(ph)%state(index_F,of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 - plasticState(ph)%dotState(index_F,of) = plasticState(ph)%dotState(index_F,of) + & - gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) - plasticState(ph)%dotState(offset_accshear_twin+j,of) = abs(gdot_twin(j)) + dst%s_twin(j,of) = & ! evolution of twin resistance j + c_TwinSlip * dot_product(prm%interaction_TwinSlip(j,1:prm%totalNslip),abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor + c_TwinTwin * dot_product(prm%interaction_TwinTwin(j,1:prm%totalNtwin),gdot_twin) ! dot gamma_twin modulated by right-side twin factor + if (stt%sumF(of) < 0.98_pReal) & ! ensure twin volume fractions stays below 1.0 + dst%sumF(of) = dst%sumF(of) + gdot_twin(j)/lattice_shearTwin(index_myFamily+i,ph) + dst%accshear_twin(j,of) = abs(gdot_twin(j)) enddo twinSystems2 enddo twinFamilies2 - - + end associate end subroutine plastic_phenopowerlaw_dotState + !-------------------------------------------------------------------------------------------------- !> @brief return array of constitutive results !-------------------------------------------------------------------------------------------------- @@ -1084,13 +740,11 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) use material, only: & material_phase, & plasticState, & - phaseAt, phasememberAt, & + phasememberAt, & phase_plasticityInstance use lattice, only: & lattice_Sslip_v, & lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & lattice_NslipSystem, & lattice_NtwinSystem, & lattice_NnonSchmid @@ -1103,126 +757,122 @@ function plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) ip, & !< integration point el !< element !< microstructure state - real(pReal), dimension(plastic_phenopowerlaw_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & + real(pReal), dimension(plasticState(material_phase(ipc,ip,el))%sizePostResults) :: & plastic_phenopowerlaw_postResults integer(pInt) :: & - instance,ph, of, & - nSlip,nTwin, & + ph, of, & o,f,i,c,j,k, & - index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily + index_myFamily real(pReal) :: & tau_slip_pos,tau_slip_neg,tau + type(tParameters) :: prm + type(tPhenopowerlawState) :: stt, dst + of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) + ph = material_phase(ipc,ip,el) - nSlip = plastic_phenopowerlaw_totalNslip(instance) - nTwin = plastic_phenopowerlaw_totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_accshear_slip = nSlip + nTwin + 3_pInt - index_accshear_twin = nSlip + nTwin + 3_pInt + nSlip + associate( prm => param(phase_plasticityInstance(ph)), & + stt => state(phase_plasticityInstance(ph)), & + dst => dotState(phase_plasticityInstance(ph))) plastic_phenopowerlaw_postResults = 0.0_pReal c = 0_pInt - outputsLoop: do o = 1_pInt,plastic_phenopowerlaw_Noutput(instance) - select case(plastic_phenopowerlaw_outputID(o,instance)) + outputsLoop: do o = 1_pInt,size(prm%outputID) + select case(prm%outputID(o)) case (resistance_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) - c = c + nSlip + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%s_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip case (accumulatedshear_slip_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt,of) - c = c + nSlip + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNslip) = stt%accshear_slip(1:prm%totalNslip,of) + c = c + prm%totalNslip case (shearrate_slip_ID) j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies1: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems1: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) tau_slip_neg = tau_slip_pos do k = 1,lattice_NnonSchmid(ph) - tau_slip_pos = tau_slip_pos + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_pos = tau_slip_pos +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenopowerlaw_nonSchmidCoeff(k,instance)* & + tau_slip_neg = tau_slip_neg +prm%nonSchmidCoeff(k)* & dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) enddo - plastic_phenopowerlaw_postResults(c+j) = plastic_phenopowerlaw_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenopowerlaw_n_slip(instance) & + plastic_phenopowerlaw_postResults(c+j) = prm%gdot0_slip*0.5_pReal* & + ((abs(tau_slip_pos)/stt%s_slip(j,of))**prm%n_slip & *sign(1.0_pReal,tau_slip_pos) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenopowerlaw_n_slip(instance) & + +(abs(tau_slip_neg)/(stt%s_slip(j,of)))**prm%n_slip & *sign(1.0_pReal,tau_slip_neg)) enddo slipSystems1 enddo slipFamilies1 - c = c + nSlip + c = c + prm%totalNslip case (resolvedstress_slip_ID) j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily + slipFamilies2: do f = 1_pInt,size(prm%Nslip,1) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_phenopowerlaw_Nslip(f,instance) + slipSystems2: do i = 1_pInt,prm%Nslip(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) enddo slipSystems2 enddo slipFamilies2 - c = c + nSlip + c = c + prm%totalNslip case (totalshear_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = & - plasticState(ph)%state(index_Gamma,of) + plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumGamma(of) c = c + 1_pInt case (resistance_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) - c = c + nTwin + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & + stt%s_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin case (accumulatedshear_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) - c = c + nTwin + plastic_phenopowerlaw_postResults(c+1_pInt:c+prm%totalNtwin) = & + stt%accshear_twin(1:prm%totalNtwin,of) + c = c + prm%totalNtwin + case (shearrate_twin_ID) j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies1: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems1: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenopowerlaw_gdot0_twin(instance)*& - (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& - plastic_phenopowerlaw_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) + plastic_phenopowerlaw_postResults(c+j) = (1.0_pReal-stt%sumF(of))*& ! 1-F + prm%gdot0_twin*& + (abs(tau)/stt%s_twin(j,of))**& + prm%n_twin*max(0.0_pReal,sign(1.0_pReal,tau)) enddo twinSystems1 enddo twinFamilies1 - c = c + nTwin + c = c + prm%totalNtwin case (resolvedstress_twin_ID) j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily + twinFamilies2: do f = 1_pInt,size(prm%Ntwin,1) index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenopowerlaw_Ntwin(f,instance) + twinSystems2: do i = 1_pInt,prm%Ntwin(f) j = j + 1_pInt plastic_phenopowerlaw_postResults(c+j) = & dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) enddo twinSystems2 enddo twinFamilies2 - c = c + nTwin + c = c + prm%totalNtwin case (totalvolfrac_twin_ID) - plastic_phenopowerlaw_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) + plastic_phenopowerlaw_postResults(c+1_pInt) = stt%sumF(of) c = c + 1_pInt end select enddo outputsLoop - + end associate end function plastic_phenopowerlaw_postResults end module plastic_phenopowerlaw diff --git a/src/prec.f90 b/src/prec.f90 index 2cdc533b6..857ec9559 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -7,6 +7,7 @@ !> @brief setting precision for real and int type !-------------------------------------------------------------------------------------------------- module prec +! ToDo: use, intrinsic :: iso_fortran_env, only : I8 => int64, WP => real64 implicit none private #if (FLOAT==8) @@ -23,26 +24,27 @@ module prec NO SUITABLE PRECISION FOR INTEGER SELECTED, STOPPING COMPILATION #endif + integer, parameter, public :: pStringLen = 256 !< default string lenth integer, parameter, public :: pLongInt = 8 !< integer representation 64 bit (was selected_int_kind(12), number with at least up to +- 1e12) real(pReal), parameter, public :: tol_math_check = 1.0e-8_pReal !< tolerance for internal math self-checks (rotation) integer(pInt), allocatable, dimension(:) :: realloc_lhs_test - type, public :: p_vec !< variable length datatype used for storage of state + type, public :: group_float !< variable length datatype used for storage of state real(pReal), dimension(:), pointer :: p - end type p_vec + end type group_float - type, public :: p_intvec + type, public :: group_int integer(pInt), dimension(:), pointer :: p - end type p_intvec + end type group_int !http://stackoverflow.com/questions/3948210/can-i-have-a-pointer-to-an-item-in-an-allocatable-array type, public :: tState integer(pInt) :: & sizeState = 0_pInt, & !< size of state sizeDotState = 0_pInt, & !< size of dot state, i.e. state(1:sizeDot) follows time evolution by dotState rates - offsetDeltaState = 0_pInt, & !< offset of delta state - sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDot) follows time evolution by deltaState increments + offsetDeltaState = 0_pInt, & !< index offset of delta state + sizeDeltaState = 0_pInt, & !< size of delta state, i.e. state(offset+1:offset+sizeDelta) follows time evolution by deltaState increments sizePostResults = 0_pInt !< size of output data real(pReal), pointer, dimension(:), contiguous :: & atolState @@ -146,7 +148,7 @@ logical elemental pure function dEq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - dEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + dEq = merge(.True.,.False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function dEq @@ -163,7 +165,7 @@ logical elemental pure function dNeq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - dNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + dNeq = merge(.False.,.True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function dNeq @@ -180,7 +182,7 @@ logical elemental pure function dEq0(a,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))) + dEq0 = merge(.True.,.False.,abs(a) <= merge(tol,eps,present(tol))) end function dEq0 @@ -197,7 +199,7 @@ logical elemental pure function dNeq0(a,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))) + dNeq0 = merge(.False.,.True.,abs(a) <= merge(tol,eps,present(tol))) end function dNeq0 @@ -215,7 +217,7 @@ logical elemental pure function cEq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - cEq = merge(.True., .False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + cEq = merge(.True.,.False.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function cEq @@ -233,7 +235,7 @@ logical elemental pure function cNeq(a,b,tol) real(pReal), intent(in), optional :: tol real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C - cNeq = merge(.False., .True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) + cNeq = merge(.False.,.True.,abs(a-b) <= merge(tol,eps,present(tol))*maxval(abs([a,b]))) end function cNeq end module prec diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 index 8e5b95ab9..4275c9533 100644 --- a/src/spectral_thermal.f90 +++ b/src/spectral_thermal.f90 @@ -65,8 +65,6 @@ subroutine spectral_thermal_init compiler_options #endif use IO, only: & - IO_intOut, & - IO_read_realFile, & IO_timeStamp use spectral_utilities, only: & wgt diff --git a/src/system_routines.f90 b/src/system_routines.f90 index 2740011b4..bea777a3d 100644 --- a/src/system_routines.f90 +++ b/src/system_routines.f90 @@ -78,28 +78,30 @@ end function isDirectory !-------------------------------------------------------------------------------------------------- !> @brief gets the current working directory !-------------------------------------------------------------------------------------------------- -logical function getCWD(str) +character(len=1024) function getCWD() use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR, & C_NULL_CHAR implicit none - character(len=*), intent(out) :: str - character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array integer(C_INT) :: stat integer :: i - str = repeat('',len(str)) - call getCurrentWorkDir_C(strFixedLength,stat) - do i=1,1024 ! copy array components until Null string is found - if (strFixedLength(i) /= C_NULL_CHAR) then - str(i:i)=strFixedLength(i) - else - exit - endif - enddo - getCWD=merge(.True.,.False.,stat /= 0_C_INT) + 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 @@ -107,28 +109,30 @@ end function getCWD !-------------------------------------------------------------------------------------------------- !> @brief gets the current host name !-------------------------------------------------------------------------------------------------- -logical function getHostName(str) +character(len=1024) function getHostName() use, intrinsic :: ISO_C_Binding, only: & C_INT, & C_CHAR, & C_NULL_CHAR implicit none - character(len=*), intent(out) :: str - character(kind=C_CHAR), dimension(1024) :: strFixedLength ! C string is an array + character(kind=C_CHAR), dimension(1024) :: charArray ! C string is an array integer(C_INT) :: stat integer :: i - str = repeat('',len(str)) - call getHostName_C(strFixedLength,stat) - do i=1,1024 ! copy array components until Null string is found - if (strFixedLength(i) /= C_NULL_CHAR) then - str(i:i)=strFixedLength(i) - else - exit - endif - enddo - getHostName=merge(.True.,.False.,stat /= 0_C_INT) + 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 diff --git a/src/vacancyflux_cahnhilliard.f90 b/src/vacancyflux_cahnhilliard.f90 index cde2cb233..ae5bd1cbc 100644 --- a/src/vacancyflux_cahnhilliard.f90 +++ b/src/vacancyflux_cahnhilliard.f90 @@ -7,7 +7,7 @@ module vacancyflux_cahnhilliard use prec, only: & pReal, & pInt, & - p_vec + group_float implicit none private @@ -26,7 +26,7 @@ module vacancyflux_cahnhilliard real(pReal), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_flucAmplitude - type(p_vec), dimension(:), allocatable, private :: & + type(group_float), dimension(:), allocatable, private :: & vacancyflux_cahnhilliard_thermalFluc real(pReal), parameter, private :: &