diff --git a/.gitignore b/.gitignore index 3fe721b7a..22c568409 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ -.noH5py *.pyc *.mod *.o @@ -8,3 +7,4 @@ bin PRIVATE build +system_report.txt diff --git a/CMakeLists.txt b/CMakeLists.txt index 9770996b1..f5d6546a9 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -124,6 +124,7 @@ endif () # Predefined sets for OPTIMIZATION/OPENMP based on BUILD_TYPE if ("${CMAKE_BUILD_TYPE}" STREQUAL "DEBUG" OR "${CMAKE_BUILD_TYPE}" STREQUAL "SYNTAXONLY" ) + set (DEBUG_FLAGS "${DEBUG_FLAGS} -DDEBUG") set (PARALLEL "OFF") set (OPTI "OFF") elseif ("${CMAKE_BUILD_TYPE}" STREQUAL "RELEASE") diff --git a/DAMASK_prerequisites.sh b/DAMASK_prerequisites.sh index 183cad106..d8f6824b9 100755 --- a/DAMASK_prerequisites.sh +++ b/DAMASK_prerequisites.sh @@ -1,9 +1,17 @@ #!/usr/bin/env bash -OUTFILE="system_report.txt" -echo generating $OUTFILE +#================================================================================================== +# Execute this script (type './DAMASK_prerequisites.sh') +# and send system_report.txt to damask@mpie.de for support +#================================================================================================== + +OUTFILE="system_report.txt" +echo =========================================== +echo + Generating $OUTFILE +echo + Send to damask@mpie.de for support +echo =========================================== + -echo date +"%m-%d-%y" >$OUTFILE # redirect STDOUT and STDERR to logfile # https://stackoverflow.com/questions/11229385/redirect-all-output-in-a-bash-script-when-using-set-x^ @@ -13,6 +21,10 @@ exec > $OUTFILE 2>&1 # https://stackoverflow.com/questions/59895/getting-the-source-directory-of-a-bash-script-from-within 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 ============================================================================================== @@ -30,19 +42,24 @@ echo System echo ============================================================================================== uname -a echo +echo PATH: $PATH +echo LD_LIBRARY_PATH: $LD_LIBRARY_PATH +echo PYTHONPATH: $PYTHONPATH +echo SHELL: $SHELL +echo echo ============================================================================================== echo Python echo ============================================================================================== DEFAULT_PYTHON=python2.7 for executable in python python2 python3 python2.7; do - if [[ "$(which $executable)x" != "x" ]]; then - echo $executable version: $($executable --version 2>&1) + if which $executable &> /dev/null; then + echo $executable version: $($executable --version 2>&1) else - echo $executable does not exist + echo $executable does not exist fi done -echo Location of $DEFAULT_PYTHON: $(ls -la $(which $DEFAULT_PYTHON)) +echo Details on $DEFAULT_PYTHON: $(ls -la $(which $DEFAULT_PYTHON)) echo for module in numpy scipy;do echo ---------------------------------------------------------------------------------------------- @@ -69,7 +86,7 @@ echo =========================================================================== echo GCC echo ============================================================================================== for executable in gcc g++ gfortran ;do - if [[ "$(which $executable)x" != "x" ]]; then + if which $executable &> /dev/null; then echo $(which $executable) version: $($executable --version 2>&1) else echo $executable does not exist @@ -80,10 +97,10 @@ echo =========================================================================== echo Intel Compiler Suite echo ============================================================================================== for executable in icc icpc ifort ;do - if [[ "$(which $executable)x" != "x" ]]; then + if which $executable &> /dev/null; then echo $(which $executable) version: $($executable --version 2>&1) else - echo $executable does not exist + echo $executable does not exist fi done echo @@ -91,7 +108,7 @@ echo =========================================================================== echo MPI Wrappers echo ============================================================================================== for executable in mpicc mpiCC mpicxx mpicxx mpifort mpif90 mpif77; do - if [[ "$(which $executable)x" != "x" ]]; then + if which $executable &> /dev/null; then echo $(which $executable) version: $($executable --show 2>&1) else echo $executable does not exist diff --git a/LICENSE b/LICENSE index 97d799216..f6371f259 100644 --- a/LICENSE +++ b/LICENSE @@ -1,6 +1,6 @@ Copyright 2011-17 Max-Planck-Institut für Eisenforschung GmbH -This program is free software: you can redistribute it and/or modify +DAMASK is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. diff --git a/PRIVATE b/PRIVATE index 55a263fc3..5fc3188c8 160000 --- a/PRIVATE +++ b/PRIVATE @@ -1 +1 @@ -Subproject commit 55a263fc30c40c16ef337be050f8901dd2747390 +Subproject commit 5fc3188c86ea1f4159db87529ac3e3169fb56e5d diff --git a/VERSION b/VERSION index 6a81d6c78..35191bcab 100644 --- a/VERSION +++ b/VERSION @@ -1 +1 @@ -v2.0.1-960-geddc2a6 +v2.0.1-1035-gd80a255 diff --git a/examples/AbaqusStandard/SX_PX_compression.cae b/examples/AbaqusStandard/SX_PX_compression.cae index 39ef89a6c..fed4472b3 100644 Binary files a/examples/AbaqusStandard/SX_PX_compression.cae and b/examples/AbaqusStandard/SX_PX_compression.cae differ diff --git a/examples/AbaqusStandard/SX_PX_compression.jnl b/examples/AbaqusStandard/SX_PX_compression.jnl index cb8406df1..4e33e1fc7 100644 --- a/examples/AbaqusStandard/SX_PX_compression.jnl +++ b/examples/AbaqusStandard/SX_PX_compression.jnl @@ -1 +1,23 @@ -# Save by abaqususer on Thu May 12 10:22:10 2011 +# Save by m.diehl on 2017_12_06-18.38.26; build 2017 2016_09_27-23.54.59 126836 +from abaqus import * +upgradeMdb( + '/nethome/storage/raid4/m.diehl/DAMASK/examples/AbaqusStandard/SX_PX_compression-6.9-1.cae' + , + '/nethome/storage/raid4/m.diehl/DAMASK/examples/AbaqusStandard/SX_PX_compression.cae') +# Save by m.diehl on 2017_12_06-18.38.26; build 2017 2016_09_27-23.54.59 126836 +from part import * +from material import * +from section import * +from assembly import * +from step import * +from interaction import * +from load import * +from mesh import * +from optimization import * +from job import * +from sketch import * +from visualization import * +from connectorBehavior import * +mdb.jobs['Job_sx-px'].setValues(description='compression', userSubroutine= + '$HOME/DAMASK/src/DAMASK_abaqus_std.f') +# Save by m.diehl on 2017_12_06-18.39.44; build 2017 2016_09_27-23.54.59 126836 diff --git a/examples/ConfigFiles/numerics.config b/examples/ConfigFiles/numerics.config index 580b58e57..ab8903927 100644 --- a/examples/ConfigFiles/numerics.config +++ b/examples/ConfigFiles/numerics.config @@ -49,7 +49,7 @@ maxVolDiscrepancy_RGC 1.0e-5 # maximum allowable relative volume discr volDiscrepancyMod_RGC 1.0e+12 discrepancyPower_RGC 5.0 -fixed_seed 0 # put any number larger than zero, integer, if you want to have a pseudo random distribution +random_seed 0 # any integer larger than zero seeds the random generator, otherwise random seeding ## spectral parameters ## err_div_tolAbs 1.0e-3 # absolute tolerance for fulfillment of stress equilibrium diff --git a/img/COPYING b/img/COPYING new file mode 100644 index 000000000..55872ace2 --- /dev/null +++ b/img/COPYING @@ -0,0 +1,94 @@ +Creative Commons Attribution-NoDerivatives 4.0 International Public License + +By exercising the Licensed Rights (defined below), You accept and agree to be bound by the terms and conditions of this Creative Commons Attribution-NoDerivatives 4.0 International Public License ("Public License"). To the extent this Public License may be interpreted as a contract, You are granted the Licensed Rights in consideration of Your acceptance of these terms and conditions, and the Licensor grants You such rights in consideration of benefits the Licensor receives from making the Licensed Material available under these terms and conditions. + +Section 1 – Definitions. + + Adapted Material means material subject to Copyright and Similar Rights that is derived from or based upon the Licensed Material and in which the Licensed Material is translated, altered, arranged, transformed, or otherwise modified in a manner requiring permission under the Copyright and Similar Rights held by the Licensor. For purposes of this Public License, where the Licensed Material is a musical work, performance, or sound recording, Adapted Material is always produced where the Licensed Material is synched in timed relation with a moving image. + Copyright and Similar Rights means copyright and/or similar rights closely related to copyright including, without limitation, performance, broadcast, sound recording, and Sui Generis Database Rights, without regard to how the rights are labeled or categorized. For purposes of this Public License, the rights specified in Section 2(b)(1)-(2) are not Copyright and Similar Rights. + Effective Technological Measures means those measures that, in the absence of proper authority, may not be circumvented under laws fulfilling obligations under Article 11 of the WIPO Copyright Treaty adopted on December 20, 1996, and/or similar international agreements. + Exceptions and Limitations means fair use, fair dealing, and/or any other exception or limitation to Copyright and Similar Rights that applies to Your use of the Licensed Material. + Licensed Material means the artistic or literary work, database, or other material to which the Licensor applied this Public License. + Licensed Rights means the rights granted to You subject to the terms and conditions of this Public License, which are limited to all Copyright and Similar Rights that apply to Your use of the Licensed Material and that the Licensor has authority to license. + Licensor means the individual(s) or entity(ies) granting rights under this Public License. + Share means to provide material to the public by any means or process that requires permission under the Licensed Rights, such as reproduction, public display, public performance, distribution, dissemination, communication, or importation, and to make material available to the public including in ways that members of the public may access the material from a place and at a time individually chosen by them. + Sui Generis Database Rights means rights other than copyright resulting from Directive 96/9/EC of the European Parliament and of the Council of 11 March 1996 on the legal protection of databases, as amended and/or succeeded, as well as other essentially equivalent rights anywhere in the world. + You means the individual or entity exercising the Licensed Rights under this Public License. Your has a corresponding meaning. + +Section 2 – Scope. + + License grant. + Subject to the terms and conditions of this Public License, the Licensor hereby grants You a worldwide, royalty-free, non-sublicensable, non-exclusive, irrevocable license to exercise the Licensed Rights in the Licensed Material to: + reproduce and Share the Licensed Material, in whole or in part; and + produce and reproduce, but not Share, Adapted Material. + Exceptions and Limitations. For the avoidance of doubt, where Exceptions and Limitations apply to Your use, this Public License does not apply, and You do not need to comply with its terms and conditions. + Term. The term of this Public License is specified in Section 6(a). + Media and formats; technical modifications allowed. The Licensor authorizes You to exercise the Licensed Rights in all media and formats whether now known or hereafter created, and to make technical modifications necessary to do so. The Licensor waives and/or agrees not to assert any right or authority to forbid You from making technical modifications necessary to exercise the Licensed Rights, including technical modifications necessary to circumvent Effective Technological Measures. For purposes of this Public License, simply making modifications authorized by this Section 2(a)(4) never produces Adapted Material. + Downstream recipients. + Offer from the Licensor – Licensed Material. Every recipient of the Licensed Material automatically receives an offer from the Licensor to exercise the Licensed Rights under the terms and conditions of this Public License. + No downstream restrictions. You may not offer or impose any additional or different terms or conditions on, or apply any Effective Technological Measures to, the Licensed Material if doing so restricts exercise of the Licensed Rights by any recipient of the Licensed Material. + No endorsement. Nothing in this Public License constitutes or may be construed as permission to assert or imply that You are, or that Your use of the Licensed Material is, connected with, or sponsored, endorsed, or granted official status by, the Licensor or others designated to receive attribution as provided in Section 3(a)(1)(A)(i). + + Other rights. + Moral rights, such as the right of integrity, are not licensed under this Public License, nor are publicity, privacy, and/or other similar personality rights; however, to the extent possible, the Licensor waives and/or agrees not to assert any such rights held by the Licensor to the limited extent necessary to allow You to exercise the Licensed Rights, but not otherwise. + Patent and trademark rights are not licensed under this Public License. + To the extent possible, the Licensor waives any right to collect royalties from You for the exercise of the Licensed Rights, whether directly or through a collecting society under any voluntary or waivable statutory or compulsory licensing scheme. In all other cases the Licensor expressly reserves any right to collect such royalties. + +Section 3 – License Conditions. + +Your exercise of the Licensed Rights is expressly made subject to the following conditions. + + Attribution. + + If You Share the Licensed Material, You must: + retain the following if it is supplied by the Licensor with the Licensed Material: + identification of the creator(s) of the Licensed Material and any others designated to receive attribution, in any reasonable manner requested by the Licensor (including by pseudonym if designated); + a copyright notice; + a notice that refers to this Public License; + a notice that refers to the disclaimer of warranties; + a URI or hyperlink to the Licensed Material to the extent reasonably practicable; + indicate if You modified the Licensed Material and retain an indication of any previous modifications; and + indicate the Licensed Material is licensed under this Public License, and include the text of, or the URI or hyperlink to, this Public License. + For the avoidance of doubt, You do not have permission under this Public License to Share Adapted Material. + You may satisfy the conditions in Section 3(a)(1) in any reasonable manner based on the medium, means, and context in which You Share the Licensed Material. For example, it may be reasonable to satisfy the conditions by providing a URI or hyperlink to a resource that includes the required information. + If requested by the Licensor, You must remove any of the information required by Section 3(a)(1)(A) to the extent reasonably practicable. + +Section 4 – Sui Generis Database Rights. + +Where the Licensed Rights include Sui Generis Database Rights that apply to Your use of the Licensed Material: + + for the avoidance of doubt, Section 2(a)(1) grants You the right to extract, reuse, reproduce, and Share all or a substantial portion of the contents of the database, provided You do not Share Adapted Material; + if You include all or a substantial portion of the database contents in a database in which You have Sui Generis Database Rights, then the database in which You have Sui Generis Database Rights (but not its individual contents) is Adapted Material; and + You must comply with the conditions in Section 3(a) if You Share all or a substantial portion of the contents of the database. + +For the avoidance of doubt, this Section 4 supplements and does not replace Your obligations under this Public License where the Licensed Rights include other Copyright and Similar Rights. + +Section 5 – Disclaimer of Warranties and Limitation of Liability. + + Unless otherwise separately undertaken by the Licensor, to the extent possible, the Licensor offers the Licensed Material as-is and as-available, and makes no representations or warranties of any kind concerning the Licensed Material, whether express, implied, statutory, or other. This includes, without limitation, warranties of title, merchantability, fitness for a particular purpose, non-infringement, absence of latent or other defects, accuracy, or the presence or absence of errors, whether or not known or discoverable. Where disclaimers of warranties are not allowed in full or in part, this disclaimer may not apply to You. + To the extent possible, in no event will the Licensor be liable to You on any legal theory (including, without limitation, negligence) or otherwise for any direct, special, indirect, incidental, consequential, punitive, exemplary, or other losses, costs, expenses, or damages arising out of this Public License or use of the Licensed Material, even if the Licensor has been advised of the possibility of such losses, costs, expenses, or damages. Where a limitation of liability is not allowed in full or in part, this limitation may not apply to You. + + The disclaimer of warranties and limitation of liability provided above shall be interpreted in a manner that, to the extent possible, most closely approximates an absolute disclaimer and waiver of all liability. + +Section 6 – Term and Termination. + + This Public License applies for the term of the Copyright and Similar Rights licensed here. However, if You fail to comply with this Public License, then Your rights under this Public License terminate automatically. + + Where Your right to use the Licensed Material has terminated under Section 6(a), it reinstates: + automatically as of the date the violation is cured, provided it is cured within 30 days of Your discovery of the violation; or + upon express reinstatement by the Licensor. + For the avoidance of doubt, this Section 6(b) does not affect any right the Licensor may have to seek remedies for Your violations of this Public License. + For the avoidance of doubt, the Licensor may also offer the Licensed Material under separate terms or conditions or stop distributing the Licensed Material at any time; however, doing so will not terminate this Public License. + Sections 1, 5, 6, 7, and 8 survive termination of this Public License. + +Section 7 – Other Terms and Conditions. + + The Licensor shall not be bound by any additional or different terms or conditions communicated by You unless expressly agreed. + Any arrangements, understandings, or agreements regarding the Licensed Material not stated herein are separate from and independent of the terms and conditions of this Public License. + +Section 8 – Interpretation. + + For the avoidance of doubt, this Public License does not, and shall not be interpreted to, reduce, limit, restrict, or impose conditions on any use of the Licensed Material that could lawfully be made without permission under this Public License. + To the extent possible, if any provision of this Public License is deemed unenforceable, it shall be automatically reformed to the minimum extent necessary to make it enforceable. If the provision cannot be reformed, it shall be severed from this Public License without affecting the enforceability of the remaining terms and conditions. + No term or condition of this Public License will be waived and no failure to comply consented to unless expressly agreed to by the Licensor. + Nothing in this Public License constitutes or may be interpreted as a limitation upon, or waiver of, any privileges and immunities that apply to the Licensor or You, including from the legal processes of any jurisdiction or authority. diff --git a/misc/DAMASK_Favicon.ico b/img/DAMASK_Favicon.ico similarity index 100% rename from misc/DAMASK_Favicon.ico rename to img/DAMASK_Favicon.ico diff --git a/misc/DAMASK_Favicon.png b/img/DAMASK_Favicon.png similarity index 100% rename from misc/DAMASK_Favicon.png rename to img/DAMASK_Favicon.png diff --git a/img/DAMASK_Logo.png b/img/DAMASK_Logo.png new file mode 100644 index 000000000..4508c869a Binary files /dev/null and b/img/DAMASK_Logo.png differ diff --git a/img/DAMASK_Logo.psd b/img/DAMASK_Logo.psd new file mode 100644 index 000000000..781750059 Binary files /dev/null and b/img/DAMASK_Logo.psd differ diff --git a/img/DAMASK_Logo.svg b/img/DAMASK_Logo.svg new file mode 100644 index 000000000..763a717ac --- /dev/null +++ b/img/DAMASK_Logo.svg @@ -0,0 +1,131 @@ + +DAMASK logoimage/svg+xmlDAMASK logoPhilip EisenlohrDAMASK; Crystal Plasticity; Multi-PhysicsMax-Planck-Institut für Eisenforschung GmbHDAMASK +The Düsseldorf Advanced Material Simulation KitCropping frameDüsseldorf Advanced Material Simulation Kit +DAMASK + \ No newline at end of file diff --git a/img/DAMASK_LogoSmall.png b/img/DAMASK_LogoSmall.png new file mode 100644 index 000000000..1ead3266d Binary files /dev/null and b/img/DAMASK_LogoSmall.png differ diff --git a/img/DAMASK_QR-Code.png b/img/DAMASK_QR-Code.png new file mode 100644 index 000000000..854820884 Binary files /dev/null and b/img/DAMASK_QR-Code.png differ diff --git a/img/DAMASK_QR-CodeBW.png b/img/DAMASK_QR-CodeBW.png new file mode 100644 index 000000000..25445c59a Binary files /dev/null and b/img/DAMASK_QR-CodeBW.png differ diff --git a/misc/DAMASK_QR-CodeBW.svg b/img/DAMASK_QR-CodeBW.svg similarity index 83% rename from misc/DAMASK_QR-CodeBW.svg rename to img/DAMASK_QR-CodeBW.svg index 38a294ed3..0fd68cffc 100644 --- a/misc/DAMASK_QR-CodeBW.svg +++ b/img/DAMASK_QR-CodeBW.svg @@ -5,11 +5,37 @@ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:svg="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg" + xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" + xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" viewBox="0 0 104.4 104.4" height="104.4" width="104.4" version="1.1" - id="svg4314"> + id="svg4314" + sodipodi:docname="DAMASK_QR-CodeBW.svg" + inkscape:version="0.92.1 r15371"> + DAMASK QR code + @@ -18,8 +44,32 @@ image/svg+xml - + DAMASK QR code + + + + Franz Roters + + + + + DAMASK; Crystal Plasticity; Multi-Physics + + + link to https://damask.mpie.de + + + + + + + +The following is a human-readable summary of (and not a substitute for) the license: + +You are free to: + + Share — copy and redistribute the material in any medium or format for any purpose, + even commercially. + + The licensor cannot revoke these freedoms as long as you follow the license terms. + +Under the following terms: + + Attribution — You must give appropriate credit, provide a link to the license, and + indicate if changes were made. You may do so in any reasonable manner, but not in + any way that suggests the licensor endorses you or your use. + + NoDerivatives — If you remix, transform, or build upon the material, you may not + distribute the modified material. + + No additional restrictions — You may not apply legal terms or technological measures + that legally restrict others from doing anything the license permits. + diff --git a/installation/mods_Abaqus/abaqus_v6.env b/installation/mods_Abaqus/abaqus_v6.env index 0bc5063a1..8d040cb23 100644 --- a/installation/mods_Abaqus/abaqus_v6.env +++ b/installation/mods_Abaqus/abaqus_v6.env @@ -44,16 +44,6 @@ double_precision=BOTH # The user will not be asked whether old job files of the same name should be deleted. ask_delete=OFF -# You can compile DAMASK into a library to be used with abaqus -# it saves you from compiling the subroutine for each job -# in this case you do not have to specify a usersubroutine file -# however if you still do, the compiled version will override that in the library -# Procedure: -# 1. create a library directory, e.g. abqlib, in your prefered location -# 2. build the library replacing your_prefered_location/abqlib with the correct path to the directory created in 1.: -# abaqus make -l DAMASK_abaqus_std.f -dir your_prefered_location/abqlib -# abaqus make -l DAMASK_abaqus_exp.f -dir your_prefered_location/abqlib -# 3. uncomment the next line after replacing your_prefered_location/abqlib with the correct path to the directory created in 1. # usub_lib_dir='your_prefered_location/abqlib' # Remove the temporary names from the namespace diff --git a/installation/mods_Abaqus/abaqus_v6_serial.env b/installation/mods_Abaqus/abaqus_v6_serial.env index 0469dc5f9..8e4d8e367 100644 --- a/installation/mods_Abaqus/abaqus_v6_serial.env +++ b/installation/mods_Abaqus/abaqus_v6_serial.env @@ -44,16 +44,6 @@ double_precision=BOTH # The user will not be asked whether old job files of the same name should be deleted. ask_delete=OFF -# You can compile DAMASK into a library to be used with abaqus -# it saves you from compiling the subroutine for each job -# in this case you do not have to specify a usersubroutine file -# however if you still do, the compiled version will override that in the library -# Procedure: -# 1. create a library directory, e.g. abqlib, in your prefered location -# 2. build the library replacing your_prefered_location/abqlib with the correct path to the directory created in 1.: -# abaqus make -l DAMASK_abaqus_std.f -dir your_prefered_location/abqlib -# abaqus make -l DAMASK_abaqus_exp.f -dir your_prefered_location/abqlib -# 3. uncomment the next line after replacing your_prefered_location/abqlib with the correct path to the directory created in 1. # usub_lib_dir='your_prefered_location/abqlib' # Remove the temporary names from the namespace diff --git a/installation/patch/PETSc3.8 b/installation/patch/PETSc3.8 new file mode 100644 index 000000000..f66ee6d09 --- /dev/null +++ b/installation/patch/PETSc3.8 @@ -0,0 +1,1012 @@ +From 87e307a9c511f3f40598edbd5996297d7804ce62 Mon Sep 17 00:00:00 2001 +From: Martin Diehl +Date: Tue, 21 Nov 2017 15:12:04 +0100 +Subject: [PATCH] due to changes in interface of PETSc + +--- + src/DAMASK_spectral.f90 | 27 +++++--------- + src/mesh.f90 | 12 +++--- + src/numerics.f90 | 13 +++---- + src/spectral_damage.f90 | 39 ++++++-------------- + src/spectral_interface.f90 | 31 ++++++++-------- + src/spectral_mech_AL.f90 | 46 ++++++++--------------- + src/spectral_mech_Basic.f90 | 52 +++++++++----------------- + src/spectral_mech_Polarisation.f90 | 52 ++++++++++---------------- + src/spectral_thermal.f90 | 75 ++++++++++++++++++-------------------- + src/spectral_utilities.f90 | 34 ++++++----------- + 10 files changed, 146 insertions(+), 235 deletions(-) + +diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 +index f32bfb7b..c315b1b8 100644 +--- a/src/DAMASK_spectral.f90 ++++ b/src/DAMASK_spectral.f90 +@@ -12,6 +12,8 @@ program DAMASK_spectral + compiler_version, & + compiler_options + #endif ++#include ++ use PETSC + use prec, only: & + pInt, & + pLongInt, & +@@ -85,11 +87,8 @@ program DAMASK_spectral + use spectral_damage + use spectral_thermal + +- + implicit none + +-#include +- + !-------------------------------------------------------------------------------------------------- + ! 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) +@@ -144,18 +143,11 @@ program DAMASK_spectral + integer(pInt), parameter :: maxByteOut = 2147483647-4096 !< limit of one file output write https://trac.mpich.org/projects/mpich/ticket/1742 + integer(pInt), parameter :: maxRealOut = maxByteOut/pReal + integer(pLongInt), dimension(2) :: outputIndex +- PetscErrorCode :: ierr ++ integer :: ierr ++ + external :: & +- quit, & +- MPI_file_open, & +- MPI_file_close, & +- MPI_file_seek, & +- MPI_file_get_position, & +- MPI_file_write, & +- MPI_abort, & +- MPI_finalize, & +- MPI_allreduce, & +- PETScFinalize ++ quit ++ + + !-------------------------------------------------------------------------------------------------- + ! init DAMASK (all modules) +@@ -448,7 +440,7 @@ program DAMASK_spectral + call MPI_file_write(resUnit, & + reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & + [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & +- (outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt), & ++ int(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults, & + MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) + if (ierr /= 0_pInt) call IO_error(error_ID=894_pInt, ext_msg='MPI_file_write') + enddo +@@ -636,8 +628,7 @@ program DAMASK_spectral + notConvergedCounter = notConvergedCounter + 1_pInt + endif; flush(6) + if (mod(inc,loadCases(currentLoadCase)%outputFrequency) == 0_pInt) then ! at output frequency +- if (worldrank == 0) & +- write(6,'(1/,a)') ' ... writing results to file ......................................' ++ write(6,'(1/,a)') ' ... writing results to file ......................................' + call materialpoint_postResults() + call MPI_file_seek (resUnit,fileOffset,MPI_SEEK_SET,ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_seek') +@@ -646,7 +637,7 @@ program DAMASK_spectral + min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) + call MPI_file_write(resUnit,reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)),& + [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & +- (outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt),& ++ int(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,& + MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) + if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') + enddo +diff --git a/src/mesh.f90 b/src/mesh.f90 +index 666fe1e3..a314c22c 100644 +--- a/src/mesh.f90 ++++ b/src/mesh.f90 +@@ -115,11 +115,6 @@ module mesh + logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information + #endif + +-#ifdef Spectral +-#include +- include 'fftw3-mpi.f03' +-#endif +- + ! These definitions should actually reside in the FE-solver specific part (different for MARC/ABAQUS) + ! Hence, I suggest to prefix with "FE_" + +@@ -476,6 +471,10 @@ subroutine mesh_init(ip,el) + use, intrinsic :: iso_fortran_env, only: & + compiler_version, & + compiler_options ++#endif ++#ifdef Spectral ++#include ++ use petscsys + #endif + use DAMASK_interface + use IO, only: & +@@ -511,6 +510,7 @@ subroutine mesh_init(ip,el) + + implicit none + #ifdef Spectral ++ include 'fftw3-mpi.f03' + integer(C_INTPTR_T) :: devNull, local_K, local_K_offset + integer :: ierr, worldsize + #endif +@@ -518,8 +518,6 @@ subroutine mesh_init(ip,el) + integer(pInt), intent(in) :: el, ip + integer(pInt) :: j + logical :: myDebug +- +- external :: MPI_comm_size + + write(6,'(/,a)') ' <<<+- mesh init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +diff --git a/src/numerics.f90 b/src/numerics.f90 +index 70c7f3c3..e7d54893 100644 +--- a/src/numerics.f90 ++++ b/src/numerics.f90 +@@ -10,9 +10,6 @@ module numerics + + implicit none + private +-#ifdef PETSc +-#include +-#endif + character(len=64), parameter, private :: & + numerics_CONFIGFILE = 'numerics.config' !< name of configuration file + +@@ -216,6 +213,10 @@ subroutine numerics_init + IO_warning, & + IO_timeStamp, & + IO_EOF ++#ifdef PETSc ++#include ++ use petscsys ++#endif + #if defined(Spectral) || defined(FEM) + !$ use OMP_LIB, only: omp_set_num_threads ! Use the standard conforming module file for omp if using the spectral solver + implicit none +@@ -232,10 +233,8 @@ subroutine numerics_init + line + !$ character(len=6) DAMASK_NumThreadsString ! environment variable DAMASK_NUM_THREADS + external :: & +- MPI_Comm_rank, & +- MPI_Comm_size, & +- MPI_Abort +- ++ PETScErrorF ! is called in the CHKERRQ macro ++ + #ifdef PETSc + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) + call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) +diff --git a/src/spectral_damage.f90 b/src/spectral_damage.f90 +index 72765987..11da3b96 100644 +--- a/src/spectral_damage.f90 ++++ b/src/spectral_damage.f90 +@@ -4,8 +4,10 @@ + !> @brief Spectral solver for nonlocal damage + !-------------------------------------------------------------------------------------------------- + module spectral_damage ++#include ++ use PETSC + use prec, only: & +- pInt, & ++ PInt, & + pReal + use math, only: & + math_I3 +@@ -18,7 +20,6 @@ module spectral_damage + + implicit none + private +-#include + + character (len=*), parameter, public :: & + spectral_damage_label = 'spectraldamage' +@@ -48,11 +49,9 @@ module spectral_damage + spectral_damage_solution, & + spectral_damage_forward, & + spectral_damage_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -86,21 +85,12 @@ subroutine spectral_damage_init() + Vec :: uBound, lBound + PetscErrorCode :: ierr + character(len=100) :: snes_type +- + external :: & +- SNESCreate, & + SNESSetOptionsPrefix, & ++ SNESGetType, & + DMDACreate3D, & +- SNESSetDM, & + DMDAGetCorners, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESSetFromOptions, & +- SNESGetType, & +- VecSet, & +- DMGetGlobalVector, & +- DMRestoreGlobalVector, & +- SNESVISetVariableBounds ++ DMDASNESSetFunctionLocal + + write(6,'(/,a)') ' <<<+- spectral_damage init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +@@ -114,7 +104,7 @@ subroutine spectral_damage_init() + do proc = 1, worldsize + call MPI_Bcast(localK(proc),1,MPI_INTEGER,proc-1,PETSC_COMM_WORLD,ierr) + enddo +- call DMDACreate3d(PETSC_COMM_WORLD, & ++ call DMDACreate3D(PETSC_COMM_WORLD, & + DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, DM_BOUNDARY_NONE, & !< cut off stencil at boundary + DMDA_STENCIL_BOX, & !< Moore (26) neighborhood around central point + grid(1),grid(2),grid(3), & !< global grid +@@ -124,9 +114,11 @@ subroutine spectral_damage_init() + damage_grid,ierr) !< handle, error + CHKERRQ(ierr) + call SNESSetDM(damage_snes,damage_grid,ierr); CHKERRQ(ierr) !< connect snes to da ++ call DMsetFromOptions(damage_grid,ierr); CHKERRQ(ierr) ++ call DMsetUp(damage_grid,ierr); CHKERRQ(ierr) + call DMCreateGlobalVector(damage_grid,solution,ierr); CHKERRQ(ierr) !< global solution vector (grid x 1, i.e. every def grad tensor) + call DMDASNESSetFunctionLocal(damage_grid,INSERT_VALUES,spectral_damage_formResidual,& +- PETSC_NULL_OBJECT,ierr) !< residual vector of same shape as solution vector ++ PETSC_NULL_SNES,ierr) !< residual vector of same shape as solution vector + CHKERRQ(ierr) + call SNESSetFromOptions(damage_snes,ierr); CHKERRQ(ierr) !< pull it all together with additional cli arguments + call SNESGetType(damage_snes,snes_type,ierr); CHKERRQ(ierr) +@@ -214,7 +206,7 @@ type(tSolutionState) function spectral_damage_solution(timeinc,timeinc_old,loadC + params%timeinc = timeinc + params%timeincOld = timeinc_old + +- call SNESSolve(damage_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) ++ call SNESSolve(damage_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(damage_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then +@@ -360,9 +352,6 @@ subroutine spectral_damage_forward() + PetscScalar, dimension(:,:,:), pointer :: x_scal + PetscErrorCode :: ierr + +- external :: & +- SNESGetDM +- + if (cutBack) then + damage_current = damage_lastInc + damage_stagInc = damage_lastInc +@@ -405,10 +394,6 @@ subroutine spectral_damage_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy +- + call VecDestroy(solution,ierr); CHKERRQ(ierr) + call SNESDestroy(damage_snes,ierr); CHKERRQ(ierr) + +diff --git a/src/spectral_interface.f90 b/src/spectral_interface.f90 +index 3c8489d0..51360ac1 100644 +--- a/src/spectral_interface.f90 ++++ b/src/spectral_interface.f90 +@@ -11,9 +11,9 @@ + module DAMASK_interface + use prec, only: & + pInt ++ + implicit none + private +-#include + logical, public, protected :: appendToOutFile = .false. !< Append to existing spectralOut file (in case of restart, not in case of regridding) + integer(pInt), public, protected :: spectralRestartInc = 1_pInt !< Increment at which calculation starts + character(len=1024), public, protected :: & +@@ -44,7 +44,13 @@ contains + subroutine DAMASK_interface_init() + use, intrinsic :: & + iso_fortran_env +- ++#include ++#if PETSC_VERSION_MAJOR!=3 || PETSC_VERSION_MINOR!=8 ++=================================================================================================== ++========================= THIS VERSION OF DAMASK REQUIRES PETSc 3.8.x ========================= ++=================================================================================================== ++#endif ++ use PETScSys + use system_routines, only: & + getHostName + +@@ -71,12 +77,9 @@ subroutine DAMASK_interface_init() + PetscErrorCode :: ierr + logical :: error + external :: & +- quit,& +- MPI_Comm_rank,& +- MPI_Comm_size,& +- PETScInitialize, & +- MPI_Init_Thread, & +- MPI_abort ++ quit, & ++ PETScErrorF, & ! is called in the CHKERRQ macro ++ PETScInitialize + + open(6, encoding='UTF-8') ! for special characters in output + +@@ -89,7 +92,7 @@ subroutine DAMASK_interface_init() + call quit(1_pInt) + endif + #endif +- call PetscInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code ++ call PETScInitialize(PETSC_NULL_CHARACTER,ierr) ! according to PETSc manual, that should be the first line in the code + CHKERRQ(ierr) ! this is a macro definition, it is case sensitive + call MPI_Comm_rank(PETSC_COMM_WORLD,worldrank,ierr);CHKERRQ(ierr) + call MPI_Comm_size(PETSC_COMM_WORLD,worldsize,ierr);CHKERRQ(ierr) +@@ -102,10 +105,6 @@ subroutine DAMASK_interface_init() + write(output_unit,'(a)') ' STDERR != 0' + call quit(1_pInt) + endif +- if (PETSC_VERSION_MAJOR /= 3 .or. PETSC_VERSION_MINOR /= 7) then +- write(6,'(a,2(i1.1,a))') 'PETSc ',PETSC_VERSION_MAJOR,'.',PETSC_VERSION_MINOR,'.x not supported' +- call quit(1_pInt) +- endif + else mainProcess + close(6) ! disable output for non-master processes (open 6 to rank specific file for debug) + open(6,file='/dev/null',status='replace') ! close(6) alone will leave some temp files in cwd +@@ -312,9 +311,9 @@ character(len=1024) function getGeometryFile(geometryParameter) + geometryParameter + character(len=1024) :: & + cwd +- integer :: posExt, posSep +- logical :: error +- external :: quit ++ integer :: posExt, posSep ++ logical :: error ++ external :: quit + + getGeometryFile = geometryParameter + posExt = scan(getGeometryFile,'.',back=.true.) +diff --git a/src/spectral_mech_AL.f90 b/src/spectral_mech_AL.f90 +index 6d0fff28..dc221f6c 100644 +--- a/src/spectral_mech_AL.f90 ++++ b/src/spectral_mech_AL.f90 +@@ -5,6 +5,8 @@ + !> @brief AL scheme solver + !-------------------------------------------------------------------------------------------------- + module spectral_mech_AL ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -16,7 +18,6 @@ module spectral_mech_AL + + implicit none + private +-#include + + character (len=*), parameter, public :: & + DAMASK_spectral_solverAL_label = 'al' +@@ -71,11 +72,9 @@ module spectral_mech_AL + AL_solution, & + AL_forward, & + AL_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -121,21 +120,17 @@ subroutine AL_init + + PetscErrorCode :: ierr + PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_lambda ++ + integer(pInt), dimension(:), allocatable :: localK + integer(pInt) :: proc + character(len=1024) :: rankStr +- ++ + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESGetConvergedReason, & ++ SNESsetOptionsPrefix, & + SNESSetConvergenceTest, & +- SNESSetFromOptions +- ++ DMDAcreate3D, & ++ DMDASNESsetFunctionLocal ++ + write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverAL init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +@@ -165,10 +160,12 @@ subroutine AL_init + da,ierr) ! handle, error + CHKERRQ(ierr) + call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) + call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) +- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_OBJECT,ierr) ++ call DMDASNESSetFunctionLocal(da,INSERT_VALUES,AL_formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) +- call SNESSetConvergenceTest(snes,AL_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ++ call SNESSetConvergenceTest(snes,AL_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) + CHKERRQ(ierr) + call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) + +@@ -280,8 +277,7 @@ type(tSolutionState) function & + SNESConvergedReason :: reason + + external :: & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve + + incInfo = incInfoIn + +@@ -304,8 +300,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! check convergence +@@ -383,10 +378,6 @@ subroutine AL_formResidual(in,x_scal,f_scal,dummy,ierr) + integer(pInt) :: & + i, j, k, e + +- external :: & +- SNESGetNumberFunctionEvals, & +- SNESGetIterationNumber +- + F => x_scal(1:3,1:3,1,& + XG_RANGE,YG_RANGE,ZG_RANGE) + F_lambda => x_scal(1:3,1:3,2,& +@@ -697,11 +688,6 @@ subroutine AL_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy, & +- DMDestroy +- + call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) + call SNESDestroy(snes,ierr); CHKERRQ(ierr) + call DMDestroy(da,ierr); CHKERRQ(ierr) +diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 +index 55403ee7..fe9eb493 100644 +--- a/src/spectral_mech_Basic.f90 ++++ b/src/spectral_mech_Basic.f90 +@@ -5,6 +5,8 @@ + !> @brief Basic scheme PETSc solver + !-------------------------------------------------------------------------------------------------- + module spectral_mech_basic ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -16,7 +18,6 @@ module spectral_mech_basic + + implicit none + private +-#include + + character (len=*), parameter, public :: & + DAMASK_spectral_SolverBasicPETSC_label = 'basicpetsc' +@@ -60,11 +61,9 @@ module spectral_mech_basic + basicPETSc_solution, & + BasicPETSc_forward, & + basicPETSc_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -116,16 +115,11 @@ subroutine basicPETSc_init + character(len=1024) :: rankStr + + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESGetConvergedReason, & ++ SNESsetOptionsPrefix, & + SNESSetConvergenceTest, & +- SNESSetFromOptions +- ++ DMDAcreate3D, & ++ DMDASNESsetFunctionLocal ++ + write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverBasicPETSc init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +@@ -152,19 +146,20 @@ subroutine basicPETSc_init + grid(1),grid(2),localK, & ! local grid + da,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) +- call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) +- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector ++ call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ! global solution vector (grid x 9, i.e. every def grad tensor) ++ call DMDASNESsetFunctionLocal(da,INSERT_VALUES,BasicPETSC_formResidual,PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector + CHKERRQ(ierr) +- call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da +- call SNESSetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" ++ call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ! connect snes to da ++ call SNESsetConvergenceTest(snes,BasicPETSC_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) ! specify custom convergence check function "_converged" + CHKERRQ(ierr) +- call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments ++ call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments + + !-------------------------------------------------------------------------------------------------- + ! init fields + call DMDAVecGetArrayF90(da,solution_vec,F,ierr); CHKERRQ(ierr) ! get the data out of PETSc to work with +- + restart: if (restartInc > 1_pInt) then + if (iand(debug_level(debug_spectral),debug_spectralRestart)/= 0) & + write(6,'(/,a,'//IO_intOut(restartInc-1_pInt)//',a)') & +@@ -253,8 +248,7 @@ type(tSolutionState) function & + SNESConvergedReason :: reason + + external :: & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve + + incInfo = incInfoIn + +@@ -274,8 +268,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! check convergence +@@ -336,10 +329,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) + PetscObject :: dummy + PetscErrorCode :: ierr + +- external :: & +- SNESGetNumberFunctionEvals, & +- SNESGetIterationNumber +- + call SNESGetNumberFunctionEvals(snes,nfuncs,ierr); CHKERRQ(ierr) + call SNESGetIterationNumber(snes,PETScIter,ierr); CHKERRQ(ierr) + +@@ -555,11 +544,6 @@ subroutine BasicPETSc_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy, & +- DMDestroy +- + call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) + call SNESDestroy(snes,ierr); CHKERRQ(ierr) + call DMDestroy(da,ierr); CHKERRQ(ierr) +diff --git a/src/spectral_mech_Polarisation.f90 b/src/spectral_mech_Polarisation.f90 +index ecf707d4..3b024f56 100644 +--- a/src/spectral_mech_Polarisation.f90 ++++ b/src/spectral_mech_Polarisation.f90 +@@ -5,6 +5,8 @@ + !> @brief Polarisation scheme solver + !-------------------------------------------------------------------------------------------------- + module spectral_mech_Polarisation ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -16,7 +18,6 @@ module spectral_mech_Polarisation + + implicit none + private +-#include + + character (len=*), parameter, public :: & + DAMASK_spectral_solverPolarisation_label = 'polarisation' +@@ -71,11 +72,9 @@ module spectral_mech_Polarisation + Polarisation_solution, & + Polarisation_forward, & + Polarisation_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -121,21 +120,17 @@ subroutine Polarisation_init + + PetscErrorCode :: ierr + PetscScalar, pointer, dimension(:,:,:,:) :: xx_psc, F, F_tau ++ + integer(pInt), dimension(:), allocatable :: localK + integer(pInt) :: proc + character(len=1024) :: rankStr +- ++ + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESGetConvergedReason, & ++ SNESsetOptionsPrefix, & + SNESSetConvergenceTest, & +- SNESSetFromOptions +- ++ DMDAcreate3D, & ++ DMDASNESsetFunctionLocal ++ + write(6,'(/,a)') ' <<<+- DAMASK_spectral_solverPolarisation init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +@@ -164,13 +159,15 @@ subroutine Polarisation_init + grid(1),grid(2),localK, & ! local grid + da,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(snes,da,ierr); CHKERRQ(ierr) +- call DMCreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) +- call DMDASNESSetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_OBJECT,ierr) ++ call SNESsetDM(snes,da,ierr); CHKERRQ(ierr) ++ call DMsetFromOptions(da,ierr); CHKERRQ(ierr) ++ call DMsetUp(da,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(da,solution_vec,ierr); CHKERRQ(ierr) ++ call DMDASNESsetFunctionLocal(da,INSERT_VALUES,Polarisation_formResidual,PETSC_NULL_SNES,ierr) + CHKERRQ(ierr) +- call SNESSetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_OBJECT,PETSC_NULL_FUNCTION,ierr) ++ call SNESsetConvergenceTest(snes,Polarisation_converged,PETSC_NULL_SNES,PETSC_NULL_FUNCTION,ierr) + CHKERRQ(ierr) +- call SNESSetFromOptions(snes,ierr); CHKERRQ(ierr) ++ call SNESsetFromOptions(snes,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! init fields +@@ -280,8 +277,7 @@ type(tSolutionState) function & + SNESConvergedReason :: reason + + external :: & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve + + incInfo = incInfoIn + +@@ -304,8 +300,7 @@ type(tSolutionState) function & + + !-------------------------------------------------------------------------------------------------- + ! solve BVP +- call SNESSolve(snes,PETSC_NULL_OBJECT,solution_vec,ierr) +- CHKERRQ(ierr) ++ call SNESsolve(snes,PETSC_NULL_VEC,solution_vec,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! check convergence +@@ -383,10 +378,6 @@ subroutine Polarisation_formResidual(in,x_scal,f_scal,dummy,ierr) + integer(pInt) :: & + i, j, k, e + +- external :: & +- SNESGetNumberFunctionEvals, & +- SNESGetIterationNumber +- + F => x_scal(1:3,1:3,1,& + XG_RANGE,YG_RANGE,ZG_RANGE) + F_tau => x_scal(1:3,1:3,2,& +@@ -698,11 +689,6 @@ subroutine Polarisation_destroy() + implicit none + PetscErrorCode :: ierr + +- external :: & +- VecDestroy, & +- SNESDestroy, & +- DMDestroy +- + call VecDestroy(solution_vec,ierr); CHKERRQ(ierr) + call SNESDestroy(snes,ierr); CHKERRQ(ierr) + call DMDestroy(da,ierr); CHKERRQ(ierr) +diff --git a/src/spectral_thermal.f90 b/src/spectral_thermal.f90 +index 322f1203..2374d83b 100644 +--- a/src/spectral_thermal.f90 ++++ b/src/spectral_thermal.f90 +@@ -4,6 +4,8 @@ + !> @brief Spectral solver for thermal conduction + !-------------------------------------------------------------------------------------------------- + module spectral_thermal ++#include ++ use PETSC + use prec, only: & + pInt, & + pReal +@@ -18,7 +20,6 @@ module spectral_thermal + + implicit none + private +-#include + + character (len=*), parameter, public :: & + spectral_thermal_label = 'spectralthermal' +@@ -48,11 +49,9 @@ module spectral_thermal + spectral_thermal_solution, & + spectral_thermal_forward, & + spectral_thermal_destroy ++ + external :: & +- PETScFinalize, & +- MPI_Abort, & +- MPI_Bcast, & +- MPI_Allreduce ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -84,28 +83,24 @@ subroutine spectral_thermal_init + thermalMapping + + implicit none +- integer(pInt), dimension(:), allocatable :: localK +- integer(pInt) :: proc + integer(pInt) :: i, j, k, cell + DM :: thermal_grid +- PetscScalar, dimension(:,:,:), pointer :: x_scal ++ + PetscErrorCode :: ierr ++ PetscScalar, dimension(:,:,:), pointer :: x_scal ++ ++ integer(pInt), dimension(:), allocatable :: localK ++ integer(pInt) :: proc + + external :: & +- SNESCreate, & +- SNESSetOptionsPrefix, & +- DMDACreate3D, & +- SNESSetDM, & +- DMDAGetCorners, & +- DMCreateGlobalVector, & +- DMDASNESSetFunctionLocal, & +- SNESSetFromOptions +- +- mainProcess: if (worldrank == 0_pInt) then +- write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' +- write(6,'(a15,a)') ' Current time: ',IO_timeStamp() ++ SNESsetOptionsPrefix, & ++ DMDAcreate3D, & ++ DMDAgetCorners, & ++ DMDASNESsetFunctionLocal ++ ++ write(6,'(/,a)') ' <<<+- spectral_thermal init -+>>>' ++ write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + #include "compilation_info.f90" +- endif mainProcess + + !-------------------------------------------------------------------------------------------------- + ! initialize solver specific parts of PETSc +@@ -124,16 +119,18 @@ subroutine spectral_thermal_init + grid (1),grid(2),localK, & ! local grid + thermal_grid,ierr) ! handle, error + CHKERRQ(ierr) +- call SNESSetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da +- call DMCreateGlobalVector(thermal_grid,solution ,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) +- call DMDASNESSetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& +- PETSC_NULL_OBJECT,ierr) ! residual vector of same shape as solution vector ++ call SNESsetDM(thermal_snes,thermal_grid,ierr); CHKERRQ(ierr) ! connect snes to da ++ call DMsetFromOptions(thermal_grid,ierr); CHKERRQ(ierr) ++ call DMsetUp(thermal_grid,ierr); CHKERRQ(ierr) ++ call DMcreateGlobalVector(thermal_grid,solution,ierr); CHKERRQ(ierr) ! global solution vector (grid x 1, i.e. every def grad tensor) ++ call DMDASNESsetFunctionLocal(thermal_grid,INSERT_VALUES,spectral_thermal_formResidual,& ++ PETSC_NULL_SNES,ierr) ! residual vector of same shape as solution vector + CHKERRQ(ierr) +- call SNESSetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments ++ call SNESsetFromOptions(thermal_snes,ierr); CHKERRQ(ierr) ! pull it all together with additional cli arguments + + !-------------------------------------------------------------------------------------------------- + ! init fields +- call DMDAGetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) ++ call DMDAgetCorners(thermal_grid,xstart,ystart,zstart,xend,yend,zend,ierr) + CHKERRQ(ierr) + xend = xstart + xend - 1 + yend = ystart + yend - 1 +@@ -149,9 +146,9 @@ subroutine spectral_thermal_init + temperature_lastInc(i,j,k) = temperature_current(i,j,k) + temperature_stagInc(i,j,k) = temperature_current(i,j,k) + enddo; enddo; enddo +- call DMDAVecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with ++ call DMDAvecGetArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) !< get the data out of PETSc to work with + x_scal(xstart:xend,ystart:yend,zstart:zend) = temperature_current +- call DMDAVecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) ++ call DMDAvecRestoreArrayF90(thermal_grid,solution,x_scal,ierr); CHKERRQ(ierr) + + !-------------------------------------------------------------------------------------------------- + ! thermal reference diffusion update +@@ -205,8 +202,8 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + external :: & + VecMin, & + VecMax, & +- SNESSolve, & +- SNESGetConvergedReason ++ SNESsolve, & ++ SNESgetConvergedReason + + spectral_thermal_solution%converged =.false. + +@@ -215,7 +212,7 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + params%timeinc = timeinc + params%timeincOld = timeinc_old + +- call SNESSolve(thermal_snes,PETSC_NULL_OBJECT,solution,ierr); CHKERRQ(ierr) ++ call SNESsolve(thermal_snes,PETSC_NULL_VEC,solution,ierr); CHKERRQ(ierr) + call SNESGetConvergedReason(thermal_snes,reason,ierr); CHKERRQ(ierr) + + if (reason < 1) then +@@ -245,14 +242,12 @@ type(tSolutionState) function spectral_thermal_solution(timeinc,timeinc_old,load + + call VecMin(solution,position,minTemperature,ierr); CHKERRQ(ierr) + call VecMax(solution,position,maxTemperature,ierr); CHKERRQ(ierr) +- if (worldrank == 0) then +- if (spectral_thermal_solution%converged) & +- write(6,'(/,a)') ' ... thermal conduction converged ..................................' +- write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',& +- minTemperature, maxTemperature, stagNorm +- write(6,'(/,a)') ' ===========================================================================' +- flush(6) +- endif ++ if (spectral_thermal_solution%converged) & ++ write(6,'(/,a)') ' ... thermal conduction converged ..................................' ++ write(6,'(/,a,f8.4,2x,f8.4,2x,f8.4,/)',advance='no') ' Minimum|Maximum|Delta Temperature / K = ',& ++ minTemperature, maxTemperature, stagNorm ++ write(6,'(/,a)') ' ===========================================================================' ++ flush(6) + + end function spectral_thermal_solution + +diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 +index 1bbf2e60..52bb07fd 100644 +--- a/src/spectral_utilities.f90 ++++ b/src/spectral_utilities.f90 +@@ -5,15 +5,16 @@ + !-------------------------------------------------------------------------------------------------- + module spectral_utilities + use, intrinsic :: iso_c_binding ++#include ++ use PETScSys + use prec, only: & + pReal, & + pInt + use math, only: & + math_I3 +- ++ + implicit none + private +-#include + include 'fftw3-mpi.f03' + + logical, public :: cutBack =.false. !< cut back of BVP solver in case convergence is not achieved or a material point is terminally ill +@@ -148,6 +149,8 @@ module spectral_utilities + FIELD_DAMAGE_ID + private :: & + utilities_getFreqDerivative ++ external :: & ++ PETScErrorF ! is called in the CHKERRQ macro + + contains + +@@ -196,12 +199,6 @@ subroutine utilities_init() + geomSize + + implicit none +- +- external :: & +- PETScOptionsClear, & +- PETScOptionsInsertString, & +- MPI_Abort +- + PetscErrorCode :: ierr + integer(pInt) :: i, j, k + integer(pInt), dimension(3) :: k_s +@@ -215,6 +212,8 @@ subroutine utilities_init() + scalarSize = 1_C_INTPTR_T, & + vecSize = 3_C_INTPTR_T, & + tensorSize = 9_C_INTPTR_T ++ external :: & ++ PetscOptionsInsertString + + write(6,'(/,a)') ' <<<+- spectral_utilities init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() +@@ -231,13 +230,13 @@ subroutine utilities_init() + trim(PETScDebug), & + ' add more using the PETSc_Options keyword in numerics.config '; flush(6) + +- call PetscOptionsClear(PETSC_NULL_OBJECT,ierr) ++ call PETScOptionsClear(PETSC_NULL_OPTIONS,ierr) + CHKERRQ(ierr) +- if(debugPETSc) call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(PETSCDEBUG),ierr) ++ if(debugPETSc) call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(PETSCDEBUG),ierr) + CHKERRQ(ierr) +- call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_defaultOptions),ierr) ++ call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_defaultOptions),ierr) + CHKERRQ(ierr) +- call PetscOptionsInsertString(PETSC_NULL_OBJECT,trim(petsc_options),ierr) ++ call PETScOptionsInsertString(PETSC_NULL_OPTIONS,trim(petsc_options),ierr) + CHKERRQ(ierr) + + grid1Red = grid(1)/2_pInt + 1_pInt +@@ -632,9 +631,6 @@ real(pReal) function utilities_divergenceRMS() + integer(pInt) :: i, j, k, ierr + complex(pReal), dimension(3) :: rescaledGeom + +- external :: & +- MPI_Allreduce +- + write(6,'(/,a)') ' ... calculating divergence ................................................' + flush(6) + +@@ -686,9 +682,6 @@ real(pReal) function utilities_curlRMS() + complex(pReal), dimension(3,3) :: curl_fourier + complex(pReal), dimension(3) :: rescaledGeom + +- external :: & +- MPI_Allreduce +- + write(6,'(/,a)') ' ... calculating curl ......................................................' + flush(6) + +@@ -1099,9 +1092,6 @@ function utilities_forwardField(timeinc,field_lastInc,rate,aim) + real(pReal), dimension(3,3) :: fieldDiff !< - aim + PetscErrorCode :: ierr + +- external :: & +- MPI_Allreduce +- + utilities_forwardField = field_lastInc + rate*timeinc + if (present(aim)) then !< correct to match average + fieldDiff = sum(sum(sum(utilities_forwardField,dim=5),dim=4),dim=3)*wgt +@@ -1193,8 +1183,6 @@ subroutine utilities_updateIPcoords(F) + integer(pInt) :: i, j, k, m, ierr + real(pReal), dimension(3) :: step, offset_coords + real(pReal), dimension(3,3) :: Favg +- external & +- MPI_Bcast + + !-------------------------------------------------------------------------------------------------- + ! integration in Fourier space +-- +2.15.0 + diff --git a/installation/patch/README.md b/installation/patch/README.md index f5b9f9706..0d553d68e 100644 --- a/installation/patch/README.md +++ b/installation/patch/README.md @@ -1,6 +1,6 @@ # DAMASK patching -This folder contains patches that modify the functionality of the current version of DAMASK prior to the corresponding inclusion in the official release. +This folder contains patches that modify the functionality of the current development version of DAMASK ahead of the corresponding adoption in the official release. ## Usage @@ -13,3 +13,13 @@ patch -p1 < installation/patch/nameOfPatch * **fwbw_derivative** switches the default spatial derivative from continuous to forward/backward difference. This generally reduces spurious oscillations in the result as the spatial accuracy of the derivative is then compatible with the underlying solution grid. + + * **PETSc-3.8** adjusts all includes and calls to PETSc to follow the 3.8.x API. + This allows to use the most recent version of PETSc. + +## Create patch +commit your changes + +```bash +git format-patch PATH_TO_COMPARE --stdout > +``` diff --git a/lib/damask/DS_HDF5.xml b/lib/damask/DS_HDF5.xml deleted file mode 100644 index 1277ce8d2..000000000 --- a/lib/damask/DS_HDF5.xml +++ /dev/null @@ -1,198 +0,0 @@ - - - - - attr - / - - store cmd history - - - - attr - / - - - - - - - Scalar - /Geometry/Vx - Geometry - Vector along x define the spectral mesh - - - - Scalar - /Geometry/Vy - Geometry - Vector along y defines the spectral mesh - - - - Scalar - /Geometry/Vz - Geometry - Vector along z defines the spectral mesh - - - - Scalar - /Geometry/ip - Geometry - - - - - Scalar - /Geometry/node - Geometry - - - - - Scalar - /Geometry/grain - Geometry - - - - - Vector - /Geometry/pos - Geometry - - - - - Scalar - /Geometry/elem - Geometry - - - - - - Scalar - /Crystallite/phase - Crystallite - - - - - Scalar - /Crystallite/texture - Crystallite - - - - - Scalar - /Crystallite/volume - Crystallite - - - - - Vector - /Crystallite/orientation - Crystallite - - - - - Vector - /Crystallite/eulerangles - Crystallite - Bunnge Euler angles in degrees - - - - Vector - /Crystallite/grainrotation - Crystallite - - - - - Tensor - /Crystallite/f - Crystallite - deformation gradient (F) - - -

- Tensor - /Crystallite/p - Crystallite - Pikola Kirkhoff stress -

- - - Tensor - /Crystallite/Cauchy - Crystallite - Cauchy stress tensor - - - - Tensor - /Crystallite/lnV - Crystallite - - - - - Scalar - /Crystallite/MisesCauchy - Crystallite - von Mises equivalent of Cauchy stress - - - - Scalar - /Crystallite/MiseslnV - Crystallite - left von Mises strain - - - - - Vector - /Constitutive/resistance_slip - Constitutive - - - - - Vector - /Constitutive/shearrate_slip - Constitutive - - - - - Vector - /Constitutive/resolvedstress_slip - Constitutive - - - - - Scalar - /Constitutive/totalshear - Constitutive - - - - - Matrix - /Constitutive/accumulatedshear_slip - Constitutive - vector contains accumulated shear per slip system - - - - - \ No newline at end of file diff --git a/lib/damask/__init__.py b/lib/damask/__init__.py index 1875ffdae..379b23547 100644 --- a/lib/damask/__init__.py +++ b/lib/damask/__init__.py @@ -1,31 +1,13 @@ # -*- coding: UTF-8 no BOM -*- """Main aggregator""" -import os,sys,time - -h5py_flag = os.path.join(os.path.dirname(__file__),'../../.noH5py') -h5py_grace = 7200 # only complain once every 7200 sec (2 hours) -h5py_msg = "h5py module not found." - -now = time.time() +import os with open(os.path.join(os.path.dirname(__file__),'../../VERSION')) as f: version = f.readline()[:-1] from .environment import Environment # noqa from .asciitable import ASCIItable # noqa -try: - from .h5table import H5Table # noqa - if os.path.exists(h5py_flag): os.remove(h5py_flag) # delete flagging file on success -except ImportError: - if os.path.exists(h5py_flag): - if now - os.path.getmtime(h5py_flag) > h5py_grace: # complain (again) every so-and-so often - sys.stderr.write(h5py_msg+'\n') - with open(h5py_flag, 'a'): - os.utime(h5py_flag,(now,now)) # update flag modification time to "now" - else: - open(h5py_flag, 'a').close() # create flagging file - sys.stderr.write(h5py_msg+'\n') # complain for the first time from .config import Material # noqa from .colormaps import Colormap, Color # noqa diff --git a/lib/damask/h5table.py b/lib/damask/h5table.py deleted file mode 100644 index 67d5853b6..000000000 --- a/lib/damask/h5table.py +++ /dev/null @@ -1,146 +0,0 @@ -# -*- coding: UTF-8 no BOM -*- - -# ----------------------------------------------------------- # -# Ideally the h5py should be enough to serve as the data # -# interface for future DAMASK, but since we are still not # -# sure when this major shift will happen, it seems to be a # -# good idea to provide a interface class that help user ease # -# into using HDF5 as the new daily storage driver. # -# ----------------------------------------------------------- # - -import os -import h5py -import numpy as np -import xml.etree.cElementTree as ET - -# ---------------------------------------------------------------- # -# python 3 has no unicode object, this ensures that the code works # -# on Python 2&3 # -# ---------------------------------------------------------------- # -try: - test = isinstance('test', unicode) -except(NameError): - unicode = str - - -def lables_to_path(label, dsXMLPath=None): - """Read the XML definition file and return the path.""" - if dsXMLPath is None: - # use the default storage layout in DS_HDF5.xml - if "h5table.pyc" in __file__: - dsXMLPath = os.path.abspath(__file__).replace("h5table.pyc", - "DS_HDF5.xml") - else: - dsXMLPath = os.path.abspath(__file__).replace("h5table.py", - "DS_HDF5.xml") - # This current implementation requires that all variables - # stay under the root node, the nesting is defined through the - # h5path. - # Allow new derived data to be put under the root - tree = ET.parse(dsXMLPath) - try: - dataType = tree.find('{}/type'.format(label)).text - h5path = tree.find('{}/h5path'.format(label)).text - except: - dataType = "Scalar" - h5path = "/{}".format(label) # just put it under root - return (dataType, h5path) - - -class H5Table(object): - """ - Lightweight interface class for h5py - - DESCRIPTION - ----------- - Interface/wrapper class for manipulating data in HDF5 with DAMASK - specialized data structure. - --> try to maintain a minimal API design. - PARAMETERS - ---------- - h5f_path: str - Absolute path of the HDF5 file - METHOD - ------ - del_entry() -- Force delete attributes/group/datasets (dangerous) - get_attr() -- Return attributes if possible - add_attr() -- Add NEW attributes to dataset/group (no force overwrite) - get_data() -- Retrieve data in numpy.ndarray - add_data() -- Add dataset to H5 file - get_cmdlog() -- Return the command used to generate the data if possible - NOTE - ---- - 1. As an interface class, it uses the lazy evaluation design - that reads the data only when it is absolutely necessary. - 2. The command line used to generate each new feature is stored with - each dataset as dataset attribute. - - """ - - def __init__(self, h5f_path, new_file=False, dsXMLFile=None): - self.h5f_path = h5f_path - self.dsXMLFile = dsXMLFile - msg = 'Created by H5Talbe from DAMASK' - mode = 'w' if new_file else 'a' - with h5py.File(self.h5f_path, mode) as h5f: - h5f['/'].attrs['description'] = msg - - def del_entry(self, feature_name): - """Delete entry in HDF5 table""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - del h5f[h5f_path] - - def get_attr(self, attr_name): - dataType, h5f_path = lables_to_path(attr_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - rst_attr = h5f[h5f_path].attrs[attr_name] - return rst_attr - - def add_attr(self, attr_name, attr_data): - dataType, h5f_path = lables_to_path(attr_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - h5f[h5f_path].attrs[attr_name] = attr_data - h5f.flush() - - def get_data(self, feature_name=None): - """Extract dataset from HDF5 table and return it in a numpy array""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - h5f_dst = h5f[h5f_path] # get the handle for target dataset(table) - rst_data = np.zeros(h5f_dst.shape) - h5f_dst.read_direct(rst_data) - return rst_data - - def add_data(self, feature_name, dataset, cmd_log=None): - """Adding new feature into existing HDF5 file""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - # NOTE: - # --> If dataset exists, delete the old one so as to write - # a new one. For brand new dataset. For brand new one, - # record its state as fresh in the cmd log. - try: - del h5f[h5f_path] - print("***deleting old {} from {}".format(feature_name,self.h5f_path)) - except: - # if no cmd log, None will used - cmd_log = str(cmd_log) + " [FRESH]" - h5f.create_dataset(h5f_path, data=dataset) - # store the cmd in log is possible - if cmd_log is not None: - h5f[h5f_path].attrs['log'] = str(cmd_log) - h5f.flush() - - def get_cmdlog(self, feature_name): - """Get cmd history used to generate the feature""" - dataType, h5f_path = lables_to_path(feature_name, - dsXMLPath=self.dsXMLFile) - with h5py.File(self.h5f_path, 'a') as h5f: - cmd_logs = h5f[h5f_path].attrs['log'] - return cmd_logs diff --git a/lib/damask/test/test.py b/lib/damask/test/test.py index d67b31f72..0e1a0284c 100644 --- a/lib/damask/test/test.py +++ b/lib/damask/test/test.py @@ -49,7 +49,8 @@ class Test(): self.dirBase = os.path.dirname(os.path.realpath(sys.modules[self.__class__.__module__].__file__)) - self.parser = OptionParser(description = '{} (Test class version: {})'.format(self.description,damask.version), + self.parser = OptionParser(option_class=damask.extendableOption, + description = '{} (Test class version: {})'.format(self.description,damask.version), usage = './test.py [options]') self.parser.add_option("-k", "--keep", action = "store_true", @@ -65,7 +66,8 @@ class Test(): help = "show all test variants without actual calculation") self.parser.add_option("-s", "--select", dest = "select", - help = "run test of given name only") + action = 'extend', metavar = '', + help = "run test(s) of given name only") self.parser.set_defaults(keep = self.keep, accept = self.accept, update = self.updateRequest, @@ -90,7 +92,7 @@ class Test(): if self.options.show: logging.critical('{}: {}'.format(variant+1,name)) elif self.options.select is not None \ - and not (name == self.options.select or str(variant+1) == self.options.select): + and not (name in self.options.select or str(variant+1) in self.options.select): pass else: try: @@ -106,8 +108,8 @@ class Test(): return variant+1 # return culprit except Exception as e: - logging.critical('exception during variant execution: "{}"'.format(e.message)) - return variant+1 # return culprit + logging.critical('exception during variant execution: "{}"'.format(str(e))) + return variant+1 # return culprit return 0 def feasible(self): @@ -320,8 +322,10 @@ class Test(): cur1Name = self.fileInCurrent(cur1) return self.compare_Array(cur0Name,cur1Name) - def compare_Table(self,headings0,file0,headings1,file1,normHeadings='',normType=None, - absoluteTolerance=False,perLine=False,skipLines=[]): + def compare_Table(self,headings0,file0, + headings1,file1, + normHeadings='',normType=None, + absoluteTolerance=False,perLine=False,skipLines=[]): import numpy as np logging.info('\n '.join(['comparing ASCII Tables',file0,file1])) @@ -335,7 +339,7 @@ class Test(): data = [[] for i in range(dataLength)] maxError = [0.0 for i in range(dataLength)] absTol = [absoluteTolerance for i in range(dataLength)] - column = [[1 for i in range(dataLength)] for j in range(2)] + column = [[1 for i in range(dataLength)] for j in range(2)] norm = [[] for i in range(dataLength)] normLength = [1 for i in range(dataLength)] @@ -366,11 +370,11 @@ class Test(): key1 = ('1_' if length[i]>1 else '') + headings1[i]['label'] normKey = ('1_' if normLength[i]>1 else '') + normHeadings[i]['label'] if key0 not in table0.labels(raw = True): - raise Exception('column {} not found in 1. table...\n'.format(key0)) + raise Exception('column "{}" not found in first table...\n'.format(key0)) elif key1 not in table1.labels(raw = True): - raise Exception('column {} not found in 2. table...\n'.format(key1)) + raise Exception('column "{}" not found in second table...\n'.format(key1)) elif normKey not in table0.labels(raw = True): - raise Exception('column {} not found in 1. table...\n'.format(normKey)) + raise Exception('column "{}" not found in first table...\n'.format(normKey)) else: column[0][i] = table0.label_index(key0) column[1][i] = table1.label_index(key1) @@ -398,9 +402,9 @@ class Test(): norm[i] = [1.0 for j in range(line0-len(skipLines))] absTol[i] = True if perLine: - logging.warning('At least one norm of {} in 1. table is 0.0, using absolute tolerance'.format(headings0[i]['label'])) + logging.warning('At least one norm of "{}" in first table is 0.0, using absolute tolerance'.format(headings0[i]['label'])) else: - logging.warning('Maximum norm of {} in 1. table is 0.0, using absolute tolerance'.format(headings0[i]['label'])) + logging.warning('Maximum norm of "{}" in first table is 0.0, using absolute tolerance'.format(headings0[i]['label'])) line1 = 0 while table1.data_read(): # read next data line of ASCII table @@ -412,7 +416,7 @@ class Test(): norm[i][line1-len(skipLines)]) line1 +=1 - if (line0 != line1): raise Exception('found {} lines in 1. table but {} in 2. table'.format(line0,line1)) + if (line0 != line1): raise Exception('found {} lines in first table but {} in second table'.format(line0,line1)) logging.info(' ********') for i in range(dataLength): @@ -559,25 +563,28 @@ class Test(): return allclose - def compare_TableRefCur(self,headingsRef,ref,headingsCur='',cur='',normHeadings='',normType=None,\ - absoluteTolerance=False,perLine=False,skipLines=[]): + def compare_TableRefCur(self,headingsRef,ref,headingsCur='',cur='', + normHeadings='',normType=None, + absoluteTolerance=False,perLine=False,skipLines=[]): - if cur == '': cur = ref - if headingsCur == '': headingsCur = headingsRef - refName = self.fileInReference(ref) - curName = self.fileInCurrent(cur) - return self.compare_Table(headingsRef,refName,headingsCur,curName,normHeadings,normType, - absoluteTolerance,perLine,skipLines) + return self.compare_Table(headingsRef, + self.fileInReference(ref), + headingsRef if headingsCur == '' else headingsCur, + self.fileInCurrent(ref if cur == '' else cur), + normHeadings,normType, + absoluteTolerance,perLine,skipLines) - def compare_TableCurCur(self,headingsCur0,Cur0,Cur1,headingsCur1='',normHeadings='',normType=None,\ - absoluteTolerance=False,perLine=False,skipLines=[]): + def compare_TableCurCur(self,headingsCur0,Cur0,Cur1, + headingsCur1='', + normHeadings='',normType=None, + absoluteTolerance=False,perLine=False,skipLines=[]): - if headingsCur1 == '': headingsCur1 = headingsCur0 - cur0Name = self.fileInCurrent(Cur0) - cur1Name = self.fileInCurrent(Cur1) - return self.compare_Table(headingsCur0,cur0Name,headingsCur1,cur1Name,normHeadings,normType, - absoluteTolerance,perLine,skipLines) + return self.compare_Table(headingsCur0, + self.fileInCurrent(Cur0), + headingsCur0 if headingsCur1 == '' else headingsCur1, + self.fileInCurrent(Cur1), + normHeadings,normType,absoluteTolerance,perLine,skipLines) def report_Success(self,culprit): @@ -585,13 +592,13 @@ class Test(): ret = culprit if culprit == 0: - msg = 'The test passed.' if (self.options.select is not None or len(self.variants) == 1) \ - else 'All {} tests passed.'.format(len(self.variants)) + count = len(self.variants) if self.options.select is None else len(self.options.select) + msg = 'Test passed.' if count == 1 else 'All {} tests passed.'.format(count) elif culprit == -1: - msg = 'Warning: Could not start test...' + msg = 'Warning: could not start test...' ret = 0 else: - msg = ' * Test "{}" failed.'.format(self.variants[culprit-1]) + msg = 'Test "{}" failed.'.format(self.variantName(culprit-1)) logging.critical('\n'.join(['*'*40,msg,'*'*40]) + '\n') return ret diff --git a/lib/damask/util.py b/lib/damask/util.py index dfe50c06e..a9761d942 100755 --- a/lib/damask/util.py +++ b/lib/damask/util.py @@ -100,6 +100,18 @@ def execute(cmd, if process.returncode != 0: raise RuntimeError('{} failed with returncode {}'.format(cmd,process.returncode)) return out,error + +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') + 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 + # ----------------------------- class extendableOption(Option): """ @@ -130,7 +142,7 @@ class backgroundMessage(threading.Thread): 'hexagon': ['⬢', '⬣'], 'square': ['▖', '▘', '▝', '▗'], 'triangle': ['ᐊ', 'ᐊ', 'ᐃ', 'ᐅ', 'ᐅ', 'ᐃ'], - 'amoeba': ['▖', '▏', '▘', '▔', '▝', '▕', '▗', '▂'], + 'amoeba': ['▖', '▏', '▘', '▔', '▝', '▕', '▗', '▁'], 'beat': ['▁', '▂', '▃', '▅', '▆', '▇', '▇', '▆', '▅', '▃', '▂'], 'prison': ['ᚋ', 'ᚌ', 'ᚍ', 'ᚏ', 'ᚎ', 'ᚍ', 'ᚌ', 'ᚋ'], 'breath': ['ᚐ', 'ᚑ', 'ᚒ', 'ᚓ', 'ᚔ', 'ᚓ', 'ᚒ', 'ᚑ', 'ᚐ'], diff --git a/misc/DAMASK_LogoLarge.png b/misc/DAMASK_LogoLarge.png deleted file mode 100644 index 2622feab4..000000000 Binary files a/misc/DAMASK_LogoLarge.png and /dev/null differ diff --git a/misc/DAMASK_LogoSmall.png b/misc/DAMASK_LogoSmall.png deleted file mode 100644 index 6897cfeea..000000000 Binary files a/misc/DAMASK_LogoSmall.png and /dev/null differ diff --git a/misc/DAMASK_QR-Code.png b/misc/DAMASK_QR-Code.png deleted file mode 100644 index 8fb9bace9..000000000 Binary files a/misc/DAMASK_QR-Code.png and /dev/null differ diff --git a/misc/DAMASK_QR-CodeBW.png b/misc/DAMASK_QR-CodeBW.png deleted file mode 100644 index b9e46a2ca..000000000 Binary files a/misc/DAMASK_QR-CodeBW.png and /dev/null differ diff --git a/processing/post/addCauchy.py b/processing/post/addCauchy.py index ab619722e..a21d91064 100755 --- a/processing/post/addCauchy.py +++ b/processing/post/addCauchy.py @@ -72,6 +72,7 @@ for name in filenames: table.head_write() # ------------------------------------------ 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) diff --git a/processing/post/addCumulative.py b/processing/post/addCumulative.py index 71fb1effc..4588d915c 100755 --- a/processing/post/addCumulative.py +++ b/processing/post/addCumulative.py @@ -73,22 +73,17 @@ for name in filenames: table.head_write() # ------------------------------------------ process data ------------------------------------------ - - table.data_readArray() - mask = [] for col,dim in zip(columns,dims): mask += range(col,col+dim) # isolate data columns to cumulate + cumulated = np.zeros(len(mask),dtype=float) # prepare output field - cumulated = np.zeros((len(table.data),len(mask))) # prepare output field - - for i,values in enumerate(table.data[:,mask]): - cumulated[i,:] = cumulated[max(0,i-1),:] + values # cumulate values - - table.data = np.hstack((table.data,cumulated)) + outputAlive = True + while outputAlive and table.data_read(): # read next data line of ASCII table + for i,col in enumerate(mask): + cumulated[i] += float(table.data[col]) # cumulate values + table.data_append(cumulated) -# ------------------------------------------ output result ----------------------------------------- - - table.data_writeArray() + outputAlive = table.data_write() # output processed line # ------------------------------------------ output finalization ----------------------------------- diff --git a/processing/post/addCurl.py b/processing/post/addCurl.py index 98a00197c..5ca851b22 100755 --- a/processing/post/addCurl.py +++ b/processing/post/addCurl.py @@ -9,41 +9,47 @@ import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) +def merge_dicts(*dict_args): + """Given any number of dicts, shallow copy and merge into a new dict, with precedence going to key value pairs in latter dicts.""" + result = {} + for dictionary in dict_args: + result.update(dictionary) + return result + def curlFFT(geomdim,field): - shapeFFT = np.array(np.shape(field))[0:3] - grid = np.array(np.shape(field)[2::-1]) - N = grid.prod() # field size - n = np.array(np.shape(field)[3:]).prod() # data size + """Calculate curl of a vector or tensor field by transforming into Fourier space.""" + shapeFFT = np.array(np.shape(field))[0:3] + grid = np.array(np.shape(field)[2::-1]) + N = grid.prod() # field size + n = np.array(np.shape(field)[3:]).prod() # data size - if n == 3: dataType = 'vector' - elif n == 9: dataType = 'tensor' + field_fourier = np.fft.rfftn(field,axes=(0,1,2),s=shapeFFT) + curl_fourier = np.empty(field_fourier.shape,'c16') - field_fourier = np.fft.rfftn(field,axes=(0,1,2),s=shapeFFT) - curl_fourier = np.empty(field_fourier.shape,'c16') + # differentiation in Fourier space + TWOPIIMG = 2.0j*math.pi + einsums = { + 3:'slm,ijkl,ijkm->ijks', # vector, 3 -> 3 + 9:'slm,ijkl,ijknm->ijksn', # tensor, 3x3 -> 3x3 + } + k_sk = np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2]))/geomdim[0] + if grid[2]%2 == 0: k_sk[grid[2]//2] = 0 # Nyquist freq=0 for even grid (Johnson, MIT, 2011) -# differentiation in Fourier space - TWOPIIMG = 2.0j*math.pi - k_sk = np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2]))/geomdim[0] - if grid[2]%2 == 0: k_sk[grid[2]//2] = 0 # for even grid, set Nyquist freq to 0 (Johnson, MIT, 2011) - - k_sj = np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1]))/geomdim[1] - if grid[1]%2 == 0: k_sj[grid[1]//2] = 0 # for even grid, set Nyquist freq to 0 (Johnson, MIT, 2011) + k_sj = np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1]))/geomdim[1] + if grid[1]%2 == 0: k_sj[grid[1]//2] = 0 # Nyquist freq=0 for even grid (Johnson, MIT, 2011) - k_si = np.arange(grid[0]//2+1)/geomdim[2] - - kk, kj, ki = np.meshgrid(k_sk,k_sj,k_si,indexing = 'ij') - k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') - - e = np.zeros((3, 3, 3)) - e[0, 1, 2] = e[1, 2, 0] = e[2, 0, 1] = 1.0 # Levi-Civita symbols - e[0, 2, 1] = e[2, 1, 0] = e[1, 0, 2] = -1.0 - - if dataType == 'tensor': # tensor, 3x3 -> 3x3 - curl_fourier = np.einsum('slm,ijkl,ijknm->ijksn',e,k_s,field_fourier)*TWOPIIMG - elif dataType == 'vector': # vector, 3 -> 3 - curl_fourier = np.einsum('slm,ijkl,ijkm->ijks',e,k_s,field_fourier)*TWOPIIMG + k_si = np.arange(grid[0]//2+1)/geomdim[2] - return np.fft.irfftn(curl_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n]) + kk, kj, ki = np.meshgrid(k_sk,k_sj,k_si,indexing = 'ij') + k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') + + e = np.zeros((3, 3, 3)) + e[0, 1, 2] = e[1, 2, 0] = e[2, 0, 1] = 1.0 # Levi-Civita symbols + e[0, 2, 1] = e[2, 1, 0] = e[1, 0, 2] = -1.0 + + curl_fourier = np.einsum(einsums[n],e,k_s,field_fourier)*TWOPIIMG + + return np.fft.irfftn(curl_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n]) # -------------------------------------------------------------------- @@ -52,31 +58,37 @@ def curlFFT(geomdim,field): parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ Add column(s) containing curl of requested column(s). -Operates on periodic ordered three-dimensional data sets. -Deals with both vector- and tensor fields. - +Operates on periodic ordered three-dimensional data sets +of vector and tensor fields. """, version = scriptID) parser.add_option('-p','--pos','--periodiccellcenter', dest = 'pos', type = 'string', metavar = 'string', help = 'label of coordinates [%default]') -parser.add_option('-v','--vector', - dest = 'vector', +parser.add_option('-l','--label', + dest = 'data', action = 'extend', metavar = '', - help = 'label(s) of vector field values') -parser.add_option('-t','--tensor', - dest = 'tensor', - action = 'extend', metavar = '', - help = 'label(s) of tensor field values') + help = 'label(s) of field values') parser.set_defaults(pos = 'pos', ) + (options,filenames) = parser.parse_args() -if options.vector is None and options.tensor is None: - parser.error('no data column specified.') +if options.data is None: parser.error('no data column specified.') + +# --- define possible data types ------------------------------------------------------------------- + +datatypes = { + 3: {'name': 'vector', + 'shape': [3], + }, + 9: {'name': 'tensor', + 'shape': [3,3], + }, + } # --- loop over input files ------------------------------------------------------------------------ @@ -87,30 +99,27 @@ for name in filenames: except: continue damask.util.report(scriptName,name) -# ------------------------------------------ read header ------------------------------------------ +# --- interpret header ---------------------------------------------------------------------------- table.head_read() -# ------------------------------------------ sanity checks ---------------------------------------- - - items = { - 'tensor': {'dim': 9, 'shape': [3,3], 'labels':options.tensor, 'active':[], 'column': []}, - 'vector': {'dim': 3, 'shape': [3], 'labels':options.vector, 'active':[], 'column': []}, - } - errors = [] remarks = [] - column = {} - - if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) + errors = [] + active = [] - for type, data in items.iteritems(): - 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)) - else: - items[type]['active'].append(what) - items[type]['column'].append(table.label_index(what)) + coordDim = table.label_dimension(options.pos) + if coordDim != 3: + errors.append('coordinates "{}" must be three-dimensional.'.format(options.pos)) + else: coordCol = table.label_index(options.pos) + + for me in options.data: + dim = table.label_dimension(me) + if dim in datatypes: + active.append(merge_dicts({'label':me},datatypes[dim])) + remarks.append('differentiating {} "{}"...'.format(datatypes[dim]['name'],me)) + else: + remarks.append('skipping "{}" of dimension {}...'.format(me,dim) if dim != -1 else \ + '"{}" not found...'.format(me) ) if remarks != []: damask.util.croak(remarks) if errors != []: @@ -121,31 +130,25 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): - for label in data['active']: - table.labels_append(['{}_curlFFT({})'.format(i+1,label) for i in range(data['dim'])]) # extend ASCII header with new labels + for data in active: + table.labels_append(['{}_curlFFT({})'.format(i+1,data['label']) + for i in range(np.prod(np.array(data['shape'])))]) # extend ASCII header with new labels table.head_write() # --------------- figure out size and grid --------------------------------------------------------- table.data_readArray() - 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 equal to smallest among other ones + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) # ------------------------------------------ process value field ----------------------------------- stack = [table.data] - for type, data in items.iteritems(): - for i,label in enumerate(data['active']): - # we need to reverse order here, because x is fastest,ie rightmost, but leftmost in our x,y,z notation - stack.append(curlFFT(size[::-1], - table.data[:,data['column'][i]:data['column'][i]+data['dim']]. - reshape(grid[::-1].tolist()+data['shape']))) + for data in active: + # we need to reverse order here, because x is fastest,ie rightmost, but leftmost in our x,y,z notation + stack.append(curlFFT(size[::-1], + table.data[:,table.label_indexrange(data['label'])]. + reshape(grid[::-1].tolist()+data['shape']))) # ------------------------------------------ output result ----------------------------------------- diff --git a/processing/post/addDerivative.py b/processing/post/addDerivative.py new file mode 100755 index 000000000..dc97c09ea --- /dev/null +++ b/processing/post/addDerivative.py @@ -0,0 +1,121 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,sys +import numpy as np +from optparse import OptionParser +import damask + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + +def derivative(coordinates,what): + + result = np.empty_like(what) + + # use differentiation by interpolation + # as described in http://www2.math.umd.edu/~dlevy/classes/amsc466/lecture-notes/differentiation-chap.pdf + + result[1:-1,:] = + what[1:-1,:] * (2.*coordinates[1:-1]-coordinates[:-2]-coordinates[2:]) / \ + ((coordinates[1:-1]-coordinates[:-2])*(coordinates[1:-1]-coordinates[2:])) \ + + what[2:,:] * (coordinates[1:-1]-coordinates[:-2]) / \ + ((coordinates[2:]-coordinates[1:-1])*(coordinates[2:]-coordinates[:-2])) \ + + what[:-2,:] * (coordinates[1:-1]-coordinates[2:]) / \ + ((coordinates[:-2]-coordinates[1:-1])*(coordinates[:-2]-coordinates[2:])) \ + + result[0,:] = (what[0,:] - what[1,:]) / \ + (coordinates[0] - coordinates[1]) + result[-1,:] = (what[-1,:] - what[-2,:]) / \ + (coordinates[-1] - coordinates[-2]) + + return result + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- + +parser = OptionParser(option_class=damask.extendableOption, usage='%prog options [file[s]]', description = """ +Add column(s) containing numerical derivative of requested column(s) with respect to given coordinates. + +""", version = scriptID) + +parser.add_option('-c','--coordinates', + dest = 'coordinates', + type = 'string', metavar='string', + help = 'heading of coordinate column') +parser.add_option('-l','--label', + dest = 'label', + action = 'extend', metavar = '', + help = 'heading of column(s) to differentiate') + + +(options,filenames) = parser.parse_args() + +if options.coordinates is None: + parser.error('no coordinate column specified.') +if options.label is None: + parser.error('no data column specified.') + +# --- loop over input files ------------------------------------------------------------------------- + +if filenames == []: filenames = [None] + +for name in filenames: + try: table = damask.ASCIItable(name = name, + buffered = False) + except: continue + damask.util.report(scriptName,name) + +# ------------------------------------------ read header ------------------------------------------ + + table.head_read() + +# ------------------------------------------ sanity checks ---------------------------------------- + + errors = [] + remarks = [] + columns = [] + dims = [] + + if table.label_dimension(options.coordinates) != 1: + errors.append('coordinate column {} is not scalar.'.format(options.coordinates)) + + for what in options.label: + dim = table.label_dimension(what) + if dim < 0: remarks.append('column {} not found...'.format(what)) + else: + dims.append(dim) + columns.append(table.label_index(what)) + table.labels_append('d({})/d({})'.format(what,options.coordinates) if dim == 1 else + ['{}_d({})/d({})'.format(i+1,what,options.coordinates) for i in range(dim)] ) # extend ASCII header with new labels + + if remarks != []: damask.util.croak(remarks) + if errors != []: + damask.util.croak(errors) + table.close(dismiss = True) + continue + +# ------------------------------------------ assemble header -------------------------------------- + + table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) + table.head_write() + +# ------------------------------------------ process data ------------------------------------------ + + table.data_readArray() + + mask = [] + for col,dim in zip(columns,dims): mask += range(col,col+dim) # isolate data columns to differentiate + + differentiated = derivative(table.data[:,table.label_index(options.coordinates)].reshape((len(table.data),1)), + table.data[:,mask]) # calculate numerical derivative + + table.data = np.hstack((table.data,differentiated)) + +# ------------------------------------------ output result ----------------------------------------- + + table.data_writeArray() + +# ------------------------------------------ output finalization ----------------------------------- + + table.close() # close ASCII tables diff --git a/processing/post/addDivergence.py b/processing/post/addDivergence.py index 232b5bc21..98916f56c 100755 --- a/processing/post/addDivergence.py +++ b/processing/post/addDivergence.py @@ -9,36 +9,43 @@ import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) +def merge_dicts(*dict_args): + """Given any number of dicts, shallow copy and merge into a new dict, with precedence going to key value pairs in latter dicts.""" + result = {} + for dictionary in dict_args: + result.update(dictionary) + return result + def divFFT(geomdim,field): - shapeFFT = np.array(np.shape(field))[0:3] - grid = np.array(np.shape(field)[2::-1]) - N = grid.prod() # field size - n = np.array(np.shape(field)[3:]).prod() # data size + """Calculate divergence of a vector or tensor field by transforming into Fourier space.""" + shapeFFT = np.array(np.shape(field))[0:3] + grid = np.array(np.shape(field)[2::-1]) + N = grid.prod() # field size + n = np.array(np.shape(field)[3:]).prod() # data size - if n == 3: dataType = 'vector' - elif n == 9: dataType = 'tensor' + field_fourier = np.fft.rfftn(field,axes=(0,1,2),s=shapeFFT) + div_fourier = np.empty(field_fourier.shape[0:len(np.shape(field))-1],'c16') - field_fourier = np.fft.rfftn(field,axes=(0,1,2),s=shapeFFT) - div_fourier = np.empty(field_fourier.shape[0:len(np.shape(field))-1],'c16') + # differentiation in Fourier space + TWOPIIMG = 2.0j*math.pi + einsums = { + 3:'ijkl,ijkl->ijk', # vector, 3 -> 1 + 9:'ijkm,ijklm->ijkl', # tensor, 3x3 -> 3 + } + k_sk = np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2]))/geomdim[0] + if grid[2]%2 == 0: k_sk[grid[2]//2] = 0 # Nyquist freq=0 for even grid (Johnson, MIT, 2011) -# differentiation in Fourier space - TWOPIIMG = 2.0j*math.pi - k_sk = np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2]))/geomdim[0] - if grid[2]%2 == 0: k_sk[grid[2]//2] = 0 # for even grid, set Nyquist freq to 0 (Johnson, MIT, 2011) - - k_sj = np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1]))/geomdim[1] - if grid[1]%2 == 0: k_sj[grid[1]//2] = 0 # for even grid, set Nyquist freq to 0 (Johnson, MIT, 2011) + k_sj = np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1]))/geomdim[1] + if grid[1]%2 == 0: k_sj[grid[1]//2] = 0 # Nyquist freq=0 for even grid (Johnson, MIT, 2011) - k_si = np.arange(grid[0]//2+1)/geomdim[2] - - kk, kj, ki = np.meshgrid(k_sk,k_sj,k_si,indexing = 'ij') - k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') - if dataType == 'tensor': # tensor, 3x3 -> 3 - div_fourier = np.einsum('ijklm,ijkm->ijkl',field_fourier,k_s)*TWOPIIMG - elif dataType == 'vector': # vector, 3 -> 1 - div_fourier = np.einsum('ijkl,ijkl->ijk',field_fourier,k_s)*TWOPIIMG - - return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n/3]) + k_si = np.arange(grid[0]//2+1)/geomdim[2] + + kk, kj, ki = np.meshgrid(k_sk,k_sj,k_si,indexing = 'ij') + k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') + + div_fourier = np.einsum(einsums[n],k_s,field_fourier)*TWOPIIMG + + return np.fft.irfftn(div_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,n/3]) # -------------------------------------------------------------------- @@ -46,32 +53,38 @@ def divFFT(geomdim,field): # -------------------------------------------------------------------- parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ -Add column(s) containing divergence of requested column(s). -Operates on periodic ordered three-dimensional data sets. -Deals with both vector- and tensor-valued fields. - +Add column(s) containing curl of requested column(s). +Operates on periodic ordered three-dimensional data sets +of vector and tensor fields. """, version = scriptID) parser.add_option('-p','--pos','--periodiccellcenter', dest = 'pos', type = 'string', metavar = 'string', help = 'label of coordinates [%default]') -parser.add_option('-v','--vector', - dest = 'vector', +parser.add_option('-l','--label', + dest = 'data', action = 'extend', metavar = '', - help = 'label(s) of vector field values') -parser.add_option('-t','--tensor', - dest = 'tensor', - action = 'extend', metavar = '', - help = 'label(s) of tensor field values') + help = 'label(s) of field values') parser.set_defaults(pos = 'pos', ) + (options,filenames) = parser.parse_args() -if options.vector is None and options.tensor is None: - parser.error('no data column specified.') +if options.data is None: parser.error('no data column specified.') + +# --- define possible data types ------------------------------------------------------------------- + +datatypes = { + 3: {'name': 'vector', + 'shape': [3], + }, + 9: {'name': 'tensor', + 'shape': [3,3], + }, + } # --- loop over input files ------------------------------------------------------------------------ @@ -82,30 +95,27 @@ for name in filenames: except: continue damask.util.report(scriptName,name) -# ------------------------------------------ read header ------------------------------------------ +# --- interpret header ---------------------------------------------------------------------------- table.head_read() -# ------------------------------------------ sanity checks ---------------------------------------- - - items = { - 'tensor': {'dim': 9, 'shape': [3,3], 'labels':options.tensor, 'active':[], 'column': []}, - 'vector': {'dim': 3, 'shape': [3], 'labels':options.vector, 'active':[], 'column': []}, - } - errors = [] remarks = [] - column = {} - - if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) + errors = [] + active = [] - for type, data in items.iteritems(): - 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)) - else: - items[type]['active'].append(what) - items[type]['column'].append(table.label_index(what)) + coordDim = table.label_dimension(options.pos) + if coordDim != 3: + errors.append('coordinates "{}" must be three-dimensional.'.format(options.pos)) + else: coordCol = table.label_index(options.pos) + + for me in options.data: + dim = table.label_dimension(me) + if dim in datatypes: + active.append(merge_dicts({'label':me},datatypes[dim])) + remarks.append('differentiating {} "{}"...'.format(datatypes[dim]['name'],me)) + else: + remarks.append('skipping "{}" of dimension {}...'.format(me,dim) if dim != -1 else \ + '"{}" not found...'.format(me) ) if remarks != []: damask.util.croak(remarks) if errors != []: @@ -116,32 +126,26 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): - for label in data['active']: - table.labels_append(['divFFT({})'.format(label) if type == 'vector' else - '{}_divFFT({})'.format(i+1,label) for i in range(data['dim']//3)]) # extend ASCII header with new labels + for data in active: + table.labels_append(['divFFT({})'.format(data['label']) if data['shape'] == [3] \ + else '{}_divFFT({})'.format(i+1,data['label']) + for i in range(np.prod(np.array(data['shape']))//3)]) # extend ASCII header with new labels table.head_write() # --------------- figure out size and grid --------------------------------------------------------- table.data_readArray() - 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 equal to smallest among other ones + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) # ------------------------------------------ process value field ----------------------------------- stack = [table.data] - for type, data in items.iteritems(): - for i,label in enumerate(data['active']): - # we need to reverse order here, because x is fastest,ie rightmost, but leftmost in our x,y,z notation - stack.append(divFFT(size[::-1], - table.data[:,data['column'][i]:data['column'][i]+data['dim']]. - reshape(grid[::-1].tolist()+data['shape']))) + for data in active: + # we need to reverse order here, because x is fastest,ie rightmost, but leftmost in our x,y,z notation + stack.append(divFFT(size[::-1], + table.data[:,table.label_indexrange(data['label'])]. + reshape(grid[::-1].tolist()+data['shape']))) # ------------------------------------------ output result ----------------------------------------- diff --git a/processing/post/addGaussian.py b/processing/post/addGaussian.py index bc5599d49..c198ef62f 100755 --- a/processing/post/addGaussian.py +++ b/processing/post/addGaussian.py @@ -18,7 +18,7 @@ scriptID = ' '.join([scriptName,damask.version]) parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ Add column(s) containing Gaussian filtered values of requested column(s). Operates on periodic and non-periodic ordered three-dimensional data sets. -For Details see scipy.ndimage documentation. +For details see scipy.ndimage documentation. """, version = scriptID) @@ -43,15 +43,14 @@ parser.add_option('--sigma', parser.add_option('--periodic', dest = 'periodic', action = 'store_true', - help = 'assume periodic grain structure' - ) + help = 'assume periodic grain structure') parser.set_defaults(pos = 'pos', order = 0, sigma = 1, - periodic = False + periodic = False, ) (options,filenames) = parser.parse_args() @@ -110,12 +109,7 @@ for name in filenames: table.data_readArray() - 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 equal to smallest among other ones + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) # ------------------------------------------ process value field ----------------------------------- diff --git a/processing/post/addGradient.py b/processing/post/addGradient.py index fefe8f84e..c788f5286 100755 --- a/processing/post/addGradient.py +++ b/processing/post/addGradient.py @@ -9,36 +9,43 @@ import damask scriptName = os.path.splitext(os.path.basename(__file__))[0] scriptID = ' '.join([scriptName,damask.version]) +def merge_dicts(*dict_args): + """Given any number of dicts, shallow copy and merge into a new dict, with precedence going to key value pairs in latter dicts.""" + result = {} + for dictionary in dict_args: + result.update(dictionary) + return result + def gradFFT(geomdim,field): - shapeFFT = np.array(np.shape(field))[0:3] - grid = np.array(np.shape(field)[2::-1]) - N = grid.prod() # field size - n = np.array(np.shape(field)[3:]).prod() # data size + """Calculate gradient of a vector or scalar field by transforming into Fourier space.""" + shapeFFT = np.array(np.shape(field))[0:3] + grid = np.array(np.shape(field)[2::-1]) + N = grid.prod() # field size + n = np.array(np.shape(field)[3:]).prod() # data size - if n == 3: dataType = 'vector' - elif n == 1: dataType = 'scalar' + field_fourier = np.fft.rfftn(field,axes=(0,1,2),s=shapeFFT) + grad_fourier = np.empty(field_fourier.shape+(3,),'c16') - field_fourier = np.fft.rfftn(field,axes=(0,1,2),s=shapeFFT) - grad_fourier = np.empty(field_fourier.shape+(3,),'c16') + # differentiation in Fourier space + TWOPIIMG = 2.0j*math.pi + einsums = { + 1:'ijkl,ijkm->ijkm', # scalar, 1 -> 3 + 3:'ijkl,ijkm->ijklm', # vector, 3 -> 3x3 + } -# differentiation in Fourier space - TWOPIIMG = 2.0j*math.pi - k_sk = np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2]))/geomdim[0] - if grid[2]%2 == 0: k_sk[grid[2]//2] = 0 # for even grid, set Nyquist freq to 0 (Johnson, MIT, 2011) - - k_sj = np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1]))/geomdim[1] - if grid[1]%2 == 0: k_sj[grid[1]//2] = 0 # for even grid, set Nyquist freq to 0 (Johnson, MIT, 2011) + k_sk = np.where(np.arange(grid[2])>grid[2]//2,np.arange(grid[2])-grid[2],np.arange(grid[2]))/geomdim[0] + if grid[2]%2 == 0: k_sk[grid[2]//2] = 0 # Nyquist freq=0 for even grid (Johnson, MIT, 2011) - k_si = np.arange(grid[0]//2+1)/geomdim[2] - - kk, kj, ki = np.meshgrid(k_sk,k_sj,k_si,indexing = 'ij') - k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') - if dataType == 'vector': # vector, 3 -> 3x3 - grad_fourier = np.einsum('ijkl,ijkm->ijklm',field_fourier,k_s)*TWOPIIMG - elif dataType == 'scalar': # scalar, 1 -> 3 - grad_fourier = np.einsum('ijkl,ijkl->ijkl',field_fourier,k_s)*TWOPIIMG + k_sj = np.where(np.arange(grid[1])>grid[1]//2,np.arange(grid[1])-grid[1],np.arange(grid[1]))/geomdim[1] + if grid[1]%2 == 0: k_sj[grid[1]//2] = 0 # Nyquist freq=0 for even grid (Johnson, MIT, 2011) - return np.fft.irfftn(grad_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,3*n]) + k_si = np.arange(grid[0]//2+1)/geomdim[2] + + kk, kj, ki = np.meshgrid(k_sk,k_sj,k_si,indexing = 'ij') + k_s = np.concatenate((ki[:,:,:,None],kj[:,:,:,None],kk[:,:,:,None]),axis = 3).astype('c16') + grad_fourier = np.einsum(einsums[n],field_fourier,k_s)*TWOPIIMG + + return np.fft.irfftn(grad_fourier,axes=(0,1,2),s=shapeFFT).reshape([N,3*n]) # -------------------------------------------------------------------- @@ -47,8 +54,8 @@ def gradFFT(geomdim,field): parser = OptionParser(option_class=damask.extendableOption, usage='%prog option(s) [ASCIItable(s)]', description = """ Add column(s) containing gradient of requested column(s). -Operates on periodic ordered three-dimensional data sets. -Deals with both vector- and scalar fields. +Operates on periodic ordered three-dimensional data sets +of vector and scalar fields. """, version = scriptID) @@ -56,22 +63,28 @@ parser.add_option('-p','--pos','--periodiccellcenter', dest = 'pos', type = 'string', metavar = 'string', help = 'label of coordinates [%default]') -parser.add_option('-v','--vector', - dest = 'vector', +parser.add_option('-l','--label', + dest = 'data', action = 'extend', metavar = '', - help = 'label(s) of vector field values') -parser.add_option('-s','--scalar', - dest = 'scalar', - action = 'extend', metavar = '', - help = 'label(s) of scalar field values') + help = 'label(s) of field values') parser.set_defaults(pos = 'pos', ) (options,filenames) = parser.parse_args() -if options.vector is None and options.scalar is None: - parser.error('no data column specified.') +if options.data is None: parser.error('no data column specified.') + +# --- define possible data types ------------------------------------------------------------------- + +datatypes = { + 1: {'name': 'scalar', + 'shape': [1], + }, + 3: {'name': 'vector', + 'shape': [3], + }, + } # --- loop over input files ------------------------------------------------------------------------ @@ -82,30 +95,27 @@ for name in filenames: except: continue damask.util.report(scriptName,name) -# ------------------------------------------ read header ------------------------------------------ +# --- interpret header ---------------------------------------------------------------------------- table.head_read() -# ------------------------------------------ sanity checks ---------------------------------------- - - items = { - 'scalar': {'dim': 1, 'shape': [1], 'labels':options.scalar, 'active':[], 'column': []}, - 'vector': {'dim': 3, 'shape': [3], 'labels':options.vector, 'active':[], 'column': []}, - } - errors = [] remarks = [] - column = {} - - if table.label_dimension(options.pos) != 3: errors.append('coordinates {} are not a vector.'.format(options.pos)) - else: colCoord = table.label_index(options.pos) + errors = [] + active = [] - for type, data in items.iteritems(): - 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)) - else: - items[type]['active'].append(what) - items[type]['column'].append(table.label_index(what)) + coordDim = table.label_dimension(options.pos) + if coordDim != 3: + errors.append('coordinates "{}" must be three-dimensional.'.format(options.pos)) + else: coordCol = table.label_index(options.pos) + + for me in options.data: + dim = table.label_dimension(me) + if dim in datatypes: + active.append(merge_dicts({'label':me},datatypes[dim])) + remarks.append('differentiating {} "{}"...'.format(datatypes[dim]['name'],me)) + else: + remarks.append('skipping "{}" of dimension {}...'.format(me,dim) if dim != -1 else \ + '"{}" not found...'.format(me) ) if remarks != []: damask.util.croak(remarks) if errors != []: @@ -116,31 +126,25 @@ for name in filenames: # ------------------------------------------ assemble header -------------------------------------- table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) - for type, data in items.iteritems(): - for label in data['active']: - table.labels_append(['{}_gradFFT({})'.format(i+1,label) for i in range(3 * data['dim'])]) # extend ASCII header with new labels + for data in active: + table.labels_append(['{}_gradFFT({})'.format(i+1,data['label']) + for i in range(coordDim*np.prod(np.array(data['shape'])))]) # extend ASCII header with new labels table.head_write() # --------------- figure out size and grid --------------------------------------------------------- table.data_readArray() - 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 equal to smallest among other ones + grid,size = damask.util.coordGridAndSize(table.data[:,table.label_indexrange(options.pos)]) # ------------------------------------------ process value field ----------------------------------- stack = [table.data] - for type, data in items.iteritems(): - for i,label in enumerate(data['active']): - # we need to reverse order here, because x is fastest,ie rightmost, but leftmost in our x,y,z notation - stack.append(gradFFT(size[::-1], - table.data[:,data['column'][i]:data['column'][i]+data['dim']]. - reshape(grid[::-1].tolist()+data['shape']))) + for data in active: + # we need to reverse order here, because x is fastest,ie rightmost, but leftmost in our x,y,z notation + stack.append(gradFFT(size[::-1], + table.data[:,table.label_indexrange(data['label'])]. + reshape(grid[::-1].tolist()+data['shape']))) # ------------------------------------------ output result ----------------------------------------- diff --git a/processing/post/addSpectralDecomposition.py b/processing/post/addSpectralDecomposition.py index f02133f1c..76bf2e875 100755 --- a/processing/post/addSpectralDecomposition.py +++ b/processing/post/addSpectralDecomposition.py @@ -49,7 +49,8 @@ for name in filenames: table.head_read() -# ------------------------------------------ sanity checks ---------------------------------------- + +# ------------------------------------------ assemble header 1 ------------------------------------ items = { 'tensor': {'dim': 9, 'shape': [3,3], 'labels':options.tensor, 'column': []}, @@ -74,12 +75,12 @@ for name in filenames: table.close(dismiss = True) continue -# ------------------------------------------ assemble header -------------------------------------- +# ------------------------------------------ assemble header 2 ------------------------------------ table.info_append(scriptID + '\t' + ' '.join(sys.argv[1:])) table.head_write() -# ------------------------------------------ process data ------------------------------------------ +# ------------------------------------------ process data ----------------------------------------- outputAlive = True while outputAlive and table.data_read(): # read next data line of ASCII table diff --git a/processing/post/h5_addCalculation.py b/processing/post/h5_addCalculation.py deleted file mode 100755 index 0ce1981a1..000000000 --- a/processing/post/h5_addCalculation.py +++ /dev/null @@ -1,72 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -# import re -# import sys -import collections -# import math -import damask -# import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- Helper functions ----- # -def listify(x): - return x if isinstance(x, collections.Iterable) else [x] - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -usageEx = """ -usage_in_details: - Column labels are tagged by '#label#' in formulas. - Use ';' for ',' in functions. Numpy is available as 'np'. - Special variables: #_row_# -- row index - - Examples: - (1) magnitude of vector -- "np.linalg.norm(#vec#)" - (2) rounded root of row number -- "round(math.sqrt(#_row_#);3)" -""" -desp = "Add or alter column(s) with derived values according to " -desp += "user-defined arithmetic operation between column(s)." - -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]' + usageEx, - description=desp, - version=scriptID) -parser.add_option('-l', '--label', - dest='labels', - action='extend', metavar='', - help='(list of) new column labels') -parser.add_option('-f', '--formula', - dest='formulas', - action='extend', metavar='', - help='(list of) formulas corresponding to labels') -parser.add_option('-c', '--condition', - dest='condition', metavar='string', - help='condition to filter rows') - -parser.set_defaults(condition=None) - -(options, filenames) = parser.parse_args() - -# ----- parse formulas ----- # -for i in range(len(options.formulas)): - options.formulas[i] = options.formulas[i].replace(';', ',') - -# ----- loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - print("!!!Cannot process {}".format(name)) - continue - damask.util.report(scriptName, name) - -# Note: -# --> not immediately needed, come back later diff --git a/processing/post/h5_addCauchy.py b/processing/post/h5_addCauchy.py deleted file mode 100755 index 84145d99d..000000000 --- a/processing/post/h5_addCauchy.py +++ /dev/null @@ -1,61 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -def getCauchy(f, p): - """Return Cauchy stress for given f and p""" - # [Cauchy] = (1/det(F)) * [P].[F_transpose] - f = f.reshape((3, 3)) - p = p.reshape((3, 3)) - return 1.0/np.linalg.det(f)*np.dot(p, f.T).reshape(9) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add column(s) containing Cauchy stress based on given column(s)" -desp += "of deformation gradient and first Piola--Kirchhoff stress." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -parser.add_option('-f', '--defgrad', - dest='defgrad', - type='string', metavar='string', - help='heading for deformation gradient [%default]') -parser.add_option('-p', '--stress', - dest='stress', - type='string', metavar='string', - help='heading for first Piola--Kirchhoff stress [%default]') - -parser.set_defaults(defgrad='f', - stress='p') - -(options, filenames) = parser.parse_args() - -# ----- loop over input H5 files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # ----- read in data ----- # - f = h5f.get_data("f") - p = h5f.get_data("p") - - # ----- calculate Cauchy stress ----- # - cauchy = [getCauchy(f_i, p_i) for f_i, p_i in zip(f, p)] - - # ----- write to HDF5 file ----- # - cmd_log = " ".join([scriptID, name]) - h5f.add_data('Cauchy', np.array(cauchy), cmd_log=cmd_log) diff --git a/processing/post/h5_addIPFcolor.py b/processing/post/h5_addIPFcolor.py deleted file mode 100755 index c92483fa5..000000000 --- a/processing/post/h5_addIPFcolor.py +++ /dev/null @@ -1,145 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import sys -import math -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - -# TODO -# This implementation will have to iterate through the array one -# element at a time, maybe there are some other ways to make this -# faster. - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add RGB color value corresponding to TSL-OIM scheme for IPF." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -parser.add_option('-p', '--pole', - dest='pole', - type='float', nargs=3, metavar='float float float', - help='lab frame direction for IPF [%default]') -msg = ', '.join(damask.Symmetry.lattices[1:]) -parser.add_option('-s', '--symmetry', - dest='symmetry', - type='choice', choices=damask.Symmetry.lattices[1:], - metavar='string', - help='crystal symmetry [%default] {{{}}} '.format(msg)) -parser.add_option('-e', '--eulers', - dest='eulers', - type='string', metavar='string', - help='Euler angles label') -parser.add_option('-d', '--degrees', - dest='degrees', - action='store_true', - help='Euler angles are given in degrees [%default]') -parser.add_option('-m', '--matrix', - dest='matrix', - type='string', metavar='string', - help='orientation matrix label') -parser.add_option('-a', - dest='a', - type='string', metavar='string', - help='crystal frame a vector label') -parser.add_option('-b', - dest='b', - type='string', metavar='string', - help='crystal frame b vector label') -parser.add_option('-c', - dest='c', - type='string', metavar='string', - help='crystal frame c vector label') -parser.add_option('-q', '--quaternion', - dest='quaternion', - type='string', metavar='string', - help='quaternion label') - -parser.set_defaults(pole=(0.0, 0.0, 1.0), - symmetry=damask.Symmetry.lattices[-1], - degrees=False) - -(options, filenames) = parser.parse_args() - -# safe guarding to have only one orientation representation -# use dynamic typing to group a,b,c into frame -options.frame = [options.a, options.b, options.c] -input = [options.eulers is not None, - all(options.frame), - options.matrix is not None, - options.quaternion is not None] - -if np.sum(input) != 1: - parser.error('needs exactly one input format.') - -# select input label that was requested (active) -label_active = np.where(input)[0][0] -(label, dim, inputtype) = [(options.eulers, 3, 'eulers'), - (options.frame, [3, 3, 3], 'frame'), - (options.matrix, 9, 'matrix'), - (options.quaternion, 4, 'quaternion')][label_active] - -# rescale degrees to radians -toRadians = math.pi/180.0 if options.degrees else 1.0 - -# only use normalized pole -pole = np.array(options.pole) -pole /= np.linalg.norm(pole) - -# ----- Loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # extract data from HDF5 file - if inputtype == 'eulers': - orieData = h5f.get_data(label) - elif inputtype == 'matrix': - orieData = h5f.get_data(label) - orieData = orieData.reshape(orieData.shape[0], 3, 3) - elif inputtype == 'frame': - vctr_a = h5f.get_data(label[0]) - vctr_b = h5f.get_data(label[1]) - vctr_c = h5f.get_data(label[2]) - frame = np.column_stack((vctr_a, vctr_b, vctr_c)) - orieData = frame.reshape(frame.shape[0], 3, 3) - elif inputtype == 'quaternion': - orieData = h5f.get_data(label) - - # calculate the IPF color - rgbArrays = np.zeros((orieData.shape[0], 3)) - for ci in range(rgbArrays.shape[0]): - if inputtype == 'eulers': - o = damask.Orientation(Eulers=np.array(orieData[ci, :])*toRadians, - symmetry=options.symmetry).reduced() - elif inputtype == 'matrix': - o = damask.Orientation(matrix=orieData[ci, :, :].transpose(), - symmetry=options.symmetry).reduced() - elif inputtype == 'frame': - o = damask.Orientation(matrix=orieData[ci, :, :], - symmetry=options.symmetry).reduced() - elif inputtype == 'quaternion': - o = damask.Orientation(quaternion=orieData[ci, :], - symmetry=options.symmetry).reduced() - rgbArrays[ci, :] = o.IPFcolor(pole) - - # compose labels/headers for IPF color (RGB) - labelIPF = 'IPF_{:g}{:g}{:g}_{sym}'.format(*options.pole, - sym=options.symmetry.lower()) - - # compose cmd history (go with dataset) - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - - # write data to HDF5 file - h5f.add_data(labelIPF, rgbArrays, cmd_log=cmd_log) diff --git a/processing/post/h5_addMises.py b/processing/post/h5_addMises.py deleted file mode 100755 index 99367cd80..000000000 --- a/processing/post/h5_addMises.py +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import sys -import math -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- Helper functions ----- # -def calcMises(what, tensor): - """Calculate von Mises equivalent""" - dev = tensor - np.trace(tensor)/3.0*np.eye(3) - symdev = 0.5*(dev+dev.T) - return math.sqrt(np.sum(symdev*symdev.T) * - { - 'stress': 3.0/2.0, - 'strain': 2.0/3.0, - }[what.lower()]) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add von Mises equivalent values for symmetric part of requested" -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -parser.add_option('-e', '--strain', - dest='strain', - metavar='string', - help='name of dataset containing strain tensors') -parser.add_option('-s', '--stress', - dest='stress', - metavar='string', - help='name of dataset containing stress tensors') - -parser.set_defaults(strain=None, stress=None) - -(options, filenames) = parser.parse_args() - -# ----- Loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # TODO: - # Could use some refactoring here - if options.stress is not None: - # extract stress tensor from HDF5 - tnsr = h5f.get_data(options.stress) - - # calculate von Mises equivalent row by row - vmStress = np.zeros(tnsr.shape[0]) - for ri in range(tnsr.shape[0]): - stressTnsr = tnsr[ri, :].reshape(3, 3) - vmStress[ri] = calcMises('stress', stressTnsr) - - # compose label - label = "Mises{}".format(options.stress) - - # prepare log info - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - - # write data to HDF5 file - h5f.add_data(label, vmStress, cmd_log=cmd_log) - - if options.strain is not None: - tnsr = h5f.get_data(options.strain) - vmStrain = np.zeros(tnsr.shape[0]) - for ri in range(tnsr.shape[0]): - strainTnsr = tnsr[ri, :].reshape(3, 3) - vmStrain[ri] = calcMises('strain', strainTnsr) - label = "Mises{}".format(options.strain) - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - h5f.add_data(label, vmStrain, cmd_log=cmd_log) diff --git a/processing/post/h5_addStrainTensors.py b/processing/post/h5_addStrainTensors.py deleted file mode 100755 index 9e3f49233..000000000 --- a/processing/post/h5_addStrainTensors.py +++ /dev/null @@ -1,156 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import sys -import damask -import numpy as np -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- Helper functions ----- # -def operator(stretch, strain, eigenvalues): - # Albrecht Bertram: Elasticity and Plasticity of Large Deformations - # An Introduction (3rd Edition, 2012), p. 102 - return {'V#ln': np.log(eigenvalues), - 'U#ln': np.log(eigenvalues), - 'V#Biot': (np.ones(3, 'd') - 1.0/eigenvalues), - 'U#Biot': (eigenvalues - np.ones(3, 'd')), - 'V#Green': (np.ones(3, 'd') - 1.0/eigenvalues/eigenvalues)*0.5, - 'U#Green': (eigenvalues*eigenvalues - np.ones(3, 'd'))*0.5, - }[stretch+'#'+strain] - - -def calcEPS(defgrads, stretchType, strainType): - """Calculate specific type of strain tensor""" - eps = np.zeros(defgrads.shape) # initialize container - - # TODO: - # this loop can use some performance boost - # (multi-threading?) - for ri in range(defgrads.shape[0]): - f = defgrads[ri, :].reshape(3, 3) - U, S, Vh = np.linalg.svd(f) - R = np.dot(U, Vh) # rotation of polar decomposition - if stretchType == 'U': - stretch = np.dot(np.linalg.inv(R), f) # F = RU - elif stretchType == 'V': - stretch = np.dot(f, np.linalg.inv(R)) # F = VR - - # kill nasty noisy data - stretch = np.where(abs(stretch) < 1e-12, 0, stretch) - - (D, V) = np.linalg.eig(stretch) - # flip principal component with negative Eigen values - neg = np.where(D < 0.0) - D[neg] *= -1. - V[:, neg] *= -1. - - # check each vector for orthogonality - # --> brutal force enforcing orthogonal base - # and re-normalize - for i, eigval in enumerate(D): - if np.dot(V[:, i], V[:, (i+1) % 3]) != 0.0: - V[:, (i+1) % 3] = np.cross(V[:, (i+2) % 3], V[:, i]) - V[:, (i+1) % 3] /= np.sqrt(np.dot(V[:, (i+1) % 3], - V[:, (i+1) % 3].conj())) - - # calculate requested version of strain tensor - d = operator(stretchType, strainType, D) - eps[ri] = (np.dot(V, np.dot(np.diag(d), V.T)).real).reshape(9) - - return eps - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -desp = "Add column(s) containing given strains based on given stretches" -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=desp, - version=scriptID) -msg = 'material strains based on right Cauchy-Green deformation, i.e., C and U' -parser.add_option('-u', '--right', - dest='right', - action='store_true', - help=msg) -msg = 'spatial strains based on left Cauchy--Green deformation, i.e., B and V' -parser.add_option('-v', '--left', - dest='left', - action='store_true', - help=msg) -parser.add_option('-0', '--logarithmic', - dest='logarithmic', - action='store_true', - help='calculate logarithmic strain tensor') -parser.add_option('-1', '--biot', - dest='biot', - action='store_true', - help='calculate biot strain tensor') -parser.add_option('-2', '--green', - dest='green', - action='store_true', - help='calculate green strain tensor') -# NOTE: -# It might be easier to just calculate one type of deformation gradient -# at a time. -msg = 'heading(s) of columns containing deformation tensor values' -parser.add_option('-f', '--defgrad', - dest='defgrad', - action='extend', - metavar='', - help=msg) - -parser.set_defaults(right=False, left=False, - logarithmic=False, biot=False, green=False, - defgrad='f') - -(options, filenames) = parser.parse_args() - -stretches = [] -strains = [] - -if options.right: - stretches.append('U') -if options.left: - stretches.append('V') - -if options.logarithmic: - strains.append('ln') -if options.biot: - strains.append('Biot') -if options.green: - strains.append('Green') - -if options.defgrad is None: - parser.error('no data column specified.') - -# ----- Loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # extract defgrads from HDF5 storage - F = h5f.get_data(options.defgrad) - - # allow calculate multiple types of strain within the - # same cmd call - for stretchType in stretches: - for strainType in strains: - # calculate strain tensor for this type - eps = calcEPS(F, stretchType, strainType) - - # compose labels/headers for this strain tensor - labelsStrain = strainType + stretchType - - # prepare log info - cmd_log = scriptID + '\t' + ' '.join(sys.argv[1:]) - - # write data to HDF5 file - h5f.add_data(labelsStrain, eps, cmd_log=cmd_log) diff --git a/processing/post/h5_addXdmfWapper.py b/processing/post/h5_addXdmfWapper.py deleted file mode 100755 index e5588a069..000000000 --- a/processing/post/h5_addXdmfWapper.py +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -# ------------------------------------------------------------------- # -# NOTE: # -# 1. Current Xdmf rendering in Paraview has some memory issue where # -# large number of polyvertices will cause segmentation fault. By # -# default, paraview output a cell based xdmf description, which # -# is working for small and medium mesh (<10,000) points. Hence a # -# rectangular mesh is used as the de facto Geometry description # -# here. # -# 2. Due to the unstable state Xdmf, it is safer to use port data # -# to VTR rather than using xdmf as interpretive layer for data # -# visualization. # -# ------------------------------------------------------------------- # - - -import os -import damask -import h5py -import xml.etree.cElementTree as ET -from optparse import OptionParser -from xml.dom import minidom -from damask.h5table import lables_to_path - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName,damask.version]) - - -# ----- HELPER FUNCTIONS -----# -def addTopLvlCmt(xmlstr, topLevelCmt): - """Add top level comment to string from ET""" - # a quick hack to add the top level comment to XML file - # --> somehow Elementtree does not provide this functionality - # --> by default - strList = xmlstr.split("\n") - strList[0] += "\n"+topLevelCmt - return "\n".join(strList) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- - -msg = 'Generate Xdmf wrapper for HDF5 file.' -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description = msg, - version = scriptID) - -(options, filenames) = parser.parse_args() - -h5f = filenames[0] -h5f_base = h5f.split("/")[-1] - -# ----- parse HDF5 file ----- # -h5f_dataDim = {} -h5f_dataPath = {} -h5f_dataType = {} -with h5py.File(h5f, 'a') as f: - labels = f.keys() - labels += f['/Constitutive'].keys() - labels += f['/Crystallite'].keys() - labels += ['Vx', 'Vy', "Vz"] - # remove group names as they do not contain real data - # TODO: use h5py/H5table API to detect dataset name to - # avoid necessary name space pruning. - labels.remove('Constitutive') - labels.remove('Crystallite') - labels.remove('Geometry') - # loop through remaining labels - for label in labels: - dataType, h5Path = lables_to_path(label) - h5f_dataType[label] = dataType - h5f_dataDim[label] = " ".join(map(str,f[h5Path].shape)) - h5f_dataPath[label] = h5Path - -# ----- constructing xdmf elements ----- # -root = ET.Element("Xdmf", version='3.3') -root.set('xmlns:xi', "http://www.w3.org/2001/XInclude") -root.append(ET.Comment('Generated Xdmf wapper for DAMASH H5 output')) - -# usually there should only be ONE domain -domain = ET.SubElement(root, 'Domain', - Name=h5f_base.split(".")[0]) - -# use global topology through reference -grid = ET.SubElement(domain, 'Grid', GridType="Uniform") -# geometry section -geometry = ET.SubElement(grid, 'Geometry', GeometryType="VXVYVZ") -for vector in ["Vz", "Vy", "Vx"]: - dataitem = ET.SubElement(geometry, "DataItem", - DataType="Float", - Dimensions=h5f_dataDim[vector], - Name=vector, - Format="HDF") - dataitem.text = h5f_base.split("/")[-1] + ":{}".format(h5f_dataPath[vector]) -# topology section -# TODO: support for other format based on given option -meshDim = [h5f_dataDim["Vz"], h5f_dataDim["Vy"], h5f_dataDim["Vx"]] -topology = ET.SubElement(grid, 'Topology', - TopologyType="3DRectMesh", - Dimensions=" ".join(map(str, meshDim))) - -# attributes section -# Question: how to properly handle data mapping for multiphase situations -labelsProcessed = ['Vx', 'Vy', 'Vz'] -# walk through each attributes -for label in labels: - if label in labelsProcessed: continue - print("adding {}...".format(label)) - attr = ET.SubElement(grid, 'Attribute', - Name=label, - Type="None", - Center="Cell") - dataitem = ET.SubElement(attr, 'DataItem', - Name=label, - Format='HDF', - Dimensions=h5f_dataDim[label]) - dataitem.text = h5f_base + ":" + h5f_dataPath[label] - # update progress list - labelsProcessed.append(label) - - -# pretty print the xdmf(xml) file content -xmlstr = minidom.parseString(ET.tostring(root)).toprettyxml(indent="\t") -xmlstr = addTopLvlCmt(xmlstr, '') -# write str to file through native python API -with open(h5f.replace(".h5", ".xmf"), 'w') as f: - f.write(xmlstr) diff --git a/processing/post/h5_vtkAddRectilinearGridData.py b/processing/post/h5_vtkAddRectilinearGridData.py deleted file mode 100755 index 1c0492f53..000000000 --- a/processing/post/h5_vtkAddRectilinearGridData.py +++ /dev/null @@ -1,191 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -import os -import vtk -import damask -from vtk.util import numpy_support -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- -msg = "Add scalars, vectors, and/or an RGB tuple from" -msg += "an HDF5 to existing VTK rectilinear grid (.vtr/.vtk)." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=msg, - version=scriptID) -parser.add_option('--vtk', - dest='vtk', - type='string', metavar='string', - help='VTK file name') -parser.add_option('--inplace', - dest='inplace', - action='store_true', - help='modify VTK file in-place') -parser.add_option('-r', '--render', - dest='render', - action='store_true', - help='open output in VTK render window') -parser.add_option('-d', '--data', - dest='data', - action='extend', metavar='', - help='scalar/vector value(s) label(s)') -parser.add_option('-t', '--tensor', - dest='tensor', - action='extend', metavar='', - help='tensor (3x3) value label(s)') -parser.add_option('-c', '--color', - dest='color', - action='extend', metavar='', - help='RGB color tuple label') -parser.add_option('-m', - '--mode', - dest='mode', - metavar='string', - type='choice', choices=['cell', 'point'], - help='cell-centered or point-centered coordinates') - -parser.set_defaults(data=[], - tensor=[], - color=[], - mode='cell', - inplace=False, - render=False) - -(options, filenames) = parser.parse_args() - -# ----- Legacy VTK format support ----- # -if os.path.splitext(options.vtk)[1] == '.vtr': - reader = vtk.vtkXMLRectilinearGridReader() - reader.SetFileName(options.vtk) - reader.Update() - rGrid = reader.GetOutput() -elif os.path.splitext(options.vtk)[1] == '.vtk': - reader = vtk.vtkGenericDataObjectReader() - reader.SetFileName(options.vtk) - reader.Update() - rGrid = reader.GetRectilinearGridOutput() -else: - parser.error('Unsupported VTK file type extension.') - -Npoints = rGrid.GetNumberOfPoints() -Ncells = rGrid.GetNumberOfCells() - -# ----- Summary output (Sanity Check) ----- # -msg = '{}: {} points and {} cells...'.format(options.vtk, - Npoints, - Ncells) -damask.util.croak(msg) - -# ----- Read HDF5 file ----- # -# NOTE: -# --> It is possible in the future we are trying to add data -# from different increment into the same VTK file, but -# this feature is not supported for the moment. -# --> Let it fail, if the HDF5 is invalid, python interpretor -# --> should be able to catch this error. -h5f = damask.H5Table(filenames[0], new_file=False) - -# ----- Process data ----- # -featureToAdd = {'data': options.data, - 'tensor': options.tensor, - 'color': options.color} -VTKarray = {} # store all vtkData in dict, then ship them to file -for dataType in featureToAdd.keys(): - featureNames = featureToAdd[dataType] - for featureName in featureNames: - VTKtype = vtk.VTK_DOUBLE - VTKdata = h5f.get_data(featureName) - if dataType == 'color': - VTKtype = vtk.VTK_UNSIGNED_CHAR - VTKdata = (VTKdata*255).astype(int) - elif dataType == 'tensor': - # Force symmetries tensor type data - VTKdata[:, 1] = VTKdata[:, 3] = 0.5*(VTKdata[:, 1]+VTKdata[:, 3]) - VTKdata[:, 2] = VTKdata[:, 6] = 0.5*(VTKdata[:, 2]+VTKdata[:, 6]) - VTKdata[:, 5] = VTKdata[:, 7] = 0.5*(VTKdata[:, 5]+VTKdata[:, 7]) - # use vtk build-in numpy support to add data (much faster) - # NOTE: - # --> deep copy is necessary here, otherwise memory leak could occur - VTKarray[featureName] = numpy_support.numpy_to_vtk(num_array=VTKdata, - deep=True, - array_type=VTKtype) - VTKarray[featureName].SetName(featureName) - -# ----- ship data to vtkGrid ----- # -mode = options.mode -damask.util.croak('{} mode...'.format(mode)) - -# NOTE: -# --> For unknown reason, Paraview only recognize one -# tensor attributes per cell, thus it would be safe -# to only add one attributes as tensor. -for dataType in featureToAdd.keys(): - featureNames = featureToAdd[dataType] - for featureName in featureNames: - if dataType == 'color': - if mode == 'cell': - rGrid.GetCellData().SetScalars(VTKarray[featureName]) - elif mode == 'point': - rGrid.GetPointData().SetScalars(VTKarray[featureName]) - elif dataType == 'tensor': - if mode == 'cell': - rGrid.GetCellData().SetTensors(VTKarray[featureName]) - elif mode == 'point': - rGrid.GetPointData().SetTensors(VTKarray[featureName]) - else: - if mode == 'cell': - rGrid.GetCellData().AddArray(VTKarray[featureName]) - elif mode == 'point': - rGrid.GetPointData().AddArray(VTKarray[featureName]) - -rGrid.Modified() -if vtk.VTK_MAJOR_VERSION <= 5: - rGrid.Update() - -# ----- write Grid to VTK file ----- # -writer = vtk.vtkXMLRectilinearGridWriter() -writer.SetDataModeToBinary() -writer.SetCompressorTypeToZLib() -vtkFileN = os.path.splitext(options.vtk)[0] -vtkExtsn = '.vtr' if options.inplace else '_added.vtr' -writer.SetFileName(vtkFileN+vtkExtsn) -if vtk.VTK_MAJOR_VERSION <= 5: - writer.SetInput(rGrid) -else: - writer.SetInputData(rGrid) -writer.Write() - -# ----- render results from script ----- # -if options.render: - mapper = vtk.vtkDataSetMapper() - mapper.SetInputData(rGrid) - actor = vtk.vtkActor() - actor.SetMapper(mapper) - - # Create the graphics structure. The renderer renders into the - # render window. The render window interactor captures mouse events - # and will perform appropriate camera or actor manipulation - # depending on the nature of the events. - - ren = vtk.vtkRenderer() - - renWin = vtk.vtkRenderWindow() - renWin.AddRenderer(ren) - - ren.AddActor(actor) - ren.SetBackground(1, 1, 1) - renWin.SetSize(200, 200) - - iren = vtk.vtkRenderWindowInteractor() - iren.SetRenderWindow(renWin) - - iren.Initialize() - renWin.Render() - iren.Start() diff --git a/processing/post/h5_vtkRectilinearGrid.py b/processing/post/h5_vtkRectilinearGrid.py deleted file mode 100755 index b08070b84..000000000 --- a/processing/post/h5_vtkRectilinearGrid.py +++ /dev/null @@ -1,135 +0,0 @@ -#!/usr/bin/env python2.7 -# -*- coding: UTF-8 no BOM -*- - -# ------------------------------------------------------------------ # -# NOTE: # -# 1. It might be a good idea to separate IO and calculation. # -# 2. Some of the calculation could be useful in other situations, # -# why not build a math_util, or math_sup module that contains # -# all the useful functions. # -# ------------------------------------------------------------------ # - -import os -import vtk -import numpy as np -import damask -from optparse import OptionParser - -scriptName = os.path.splitext(os.path.basename(__file__))[0] -scriptID = ' '.join([scriptName, damask.version]) - - -# ----- HELPER FUNCTION ----- # -def getMeshFromXYZ(xyzArray, mode): - """Calc Vx,Vy,Vz vectors for vtk rectangular mesh""" - # NOTE: - # --> np.unique will automatically sort the list - # --> although not exactly n(1), but since mesh dimension should - # small anyway, so this is still light weight. - dim = xyzArray.shape[1] # 2D:2, 3D:3 - coords = [np.unique(xyzArray[:, i]) for i in range(dim)] - - if mode == 'cell': - # since x, y, z might now have the same number of elements, - # we have to deal with them individually - for ri in range(dim): - vctr_pt = coords[ri] - vctr_cell = np.empty(len(vctr_pt)+1) - # calculate first and last end point - vctr_cell[0] = vctr_pt[0] - 0.5*abs(vctr_pt[1] - vctr_pt[0]) - vctr_cell[-1] = vctr_pt[-1] + 0.5*abs(vctr_pt[-2] - vctr_pt[-1]) - for cj in range(1, len(vctr_cell)-1): - vctr_cell[cj] = 0.5*(vctr_pt[cj-1] + vctr_pt[cj]) - # update the coords - coords[ri] = vctr_cell - - if dim < 3: - coords.append([0]) # expand to a 3D with 0 for z - - # auxiliary description - grid = np.array(map(len, coords), 'i') - N = grid.prod() if mode == 'point' else (grid-1).prod() - return coords, grid, N - -# -------------------------------------------------------------------- -# MAIN -# -------------------------------------------------------------------- - -msg = "Create regular voxel grid from points in an ASCIItable." -parser = OptionParser(option_class=damask.extendableOption, - usage='%prog options [file[s]]', - description=msg, - version=scriptID) - -parser.add_option('-m', - '--mode', - dest='mode', - metavar='string', - type='choice', choices=['cell', 'point'], - help='cell-centered or point-centered coordinates') -parser.add_option('-p', - '--pos', '--position', - dest='pos', - type='string', metavar='string', - help='label of coordinates [%default]') - -parser.set_defaults(mode='cell', - pos='pos') - -(options, filenames) = parser.parse_args() - -# ----- loop over input files ----- # -for name in filenames: - try: - h5f = damask.H5Table(name, new_file=False) - except: - continue - damask.util.report(scriptName, name) - - # ----- read xyzArray from HDF5 file ----- # - xyzArray = h5f.get_data(options.pos) - - # ----- figure out size and grid ----- # - coords, grid, N = getMeshFromXYZ(xyzArray, options.mode) - - # ----- process data ----- # - rGrid = vtk.vtkRectilinearGrid() - # WARNING: list expansion does not work here as these are - # just pointers for a vtk instance. Simply put, - # DON't USE - # [] * - coordArray = [vtk.vtkDoubleArray(), - vtk.vtkDoubleArray(), - vtk.vtkDoubleArray()] - - rGrid.SetDimensions(*grid) - for i, points in enumerate(coords): - for point in points: - coordArray[i].InsertNextValue(point) - - rGrid.SetXCoordinates(coordArray[0]) - rGrid.SetYCoordinates(coordArray[1]) - rGrid.SetZCoordinates(coordArray[2]) - - # ----- output result ----- # - dirPath = os.path.split(name)[0] - if name: - writer = vtk.vtkXMLRectilinearGridWriter() - writer.SetCompressorTypeToZLib() - writer.SetDataModeToBinary() - # getting the name is a little bit tricky - vtkFileName = os.path.splitext(os.path.split(name)[1])[0] - vtkFileName += '_{}({})'.format(options.pos, options.mode) - vtkFileName += '.' + writer.GetDefaultFileExtension() - writer.SetFileName(os.path.join(dirPath, vtkFileName)) - else: - writer = vtk.vtkDataSetWriter() - writer.SetHeader('# powered by '+scriptID) - writer.WriteToOutputStringOn() - - if vtk.VTK_MAJOR_VERSION <= 5: - writer.SetInput(rGrid) - else: - writer.SetInputData(rGrid) - - writer.Write() diff --git a/processing/post/marc_to_vtk.py b/processing/post/marc_to_vtk.py new file mode 100755 index 000000000..05f7a6908 --- /dev/null +++ b/processing/post/marc_to_vtk.py @@ -0,0 +1,199 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,sys,re +import argparse +import damask +import vtk, numpy as np + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName, damask.version]) + +parser = argparse.ArgumentParser(description='Convert from Marc input file format (.dat) to VTK format (.vtu)', version = scriptID) +parser.add_argument('filename', type=str, help='file to convert') +parser.add_argument('-t', '--table', type=str, help='ASCIItable file containing nodal data to subdivide and interpolate') + +args = parser.parse_args() + +with open(args.filename, 'r') as marcfile: + marctext = marcfile.read(); + +# Load table (if any) +if args.table is not None: + try: + table = damask.ASCIItable( + name=args.table, + outname='subdivided_{}'.format(args.table), + buffered=True + ) + + table.head_read() + table.data_readArray() + + # Python list is faster for appending + nodal_data = list(table.data) + except: args.table = None + +# Extract connectivity chunk from file... +connectivity_text = re.findall(r'connectivity[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0] +connectivity_lines = re.split(r'[\n\r]+', connectivity_text, flags=(re.MULTILINE | re.DOTALL)) +connectivity_header = connectivity_lines[0] +connectivity_lines = connectivity_lines[1:] + +# Construct element map +elements = dict(map(lambda line: + ( + int(line[0:10]), # index + { + 'type': int(line[10:20]), + 'verts': list(map(int, re.split(r' +', line[20:].strip()))) + } + ), connectivity_lines)) + +# Extract coordinate chunk from file +coordinates_text = re.findall(r'coordinates[\n\r]+(.*?)[\n\r]+[a-zA-Z]', marctext, flags=(re.MULTILINE | re.DOTALL))[0] +coordinates_lines = re.split(r'[\n\r]+', coordinates_text, flags=(re.MULTILINE | re.DOTALL)) +coordinates_header = coordinates_lines[0] +coordinates_lines = coordinates_lines[1:] + +# marc input file does not use "e" in scientific notation, this adds it and converts +fl_format = lambda string: float(re.sub(r'(\d)([\+\-])', r'\1e\2', string)) +# Construct coordinate map +coordinates = dict(map(lambda line: + ( + int(line[0:10]), + np.array([ + fl_format(line[10:30]), + fl_format(line[30:50]), + fl_format(line[50:70]) + ]) + ), coordinates_lines)) + +# Subdivide volumes +grid = vtk.vtkUnstructuredGrid() +vertex_count = len(coordinates) +edge_to_vert = dict() # when edges are subdivided, a new vertex in the middle is produced and placed in here +ordered_pair = lambda a, b: (a, b) if a < b else (b, a) # edges are bidirectional + +def subdivide_edge(vert1, vert2): + edge = ordered_pair(vert1, vert2) + + if edge in edge_to_vert: + return edge_to_vert[edge] + + # Vertex does not exist, create it + newvert = len(coordinates) + 1 + coordinates[newvert] = 0.5 * (coordinates[vert1] + coordinates[vert2]) # Average + edge_to_vert[edge] = newvert; + + # Interpolate nodal data + if args.table is not None: + nodal_data.append(0.5 * (nodal_data[vert1 - 1] + nodal_data[vert2 - 1])) + return newvert; + +for el_id in range(1, len(elements) + 1): # Marc starts counting at 1 + el = elements[el_id] + if el['type'] == 7: + # Hexahedron, subdivided + + # There may be a better way to iterate over these, but this is consistent + # with the ordering scheme provided at https://damask.mpie.de/pub/Documentation/ElementType + + subverts = np.zeros((3,3,3), dtype=int) + # Get corners + subverts[0, 0, 0] = el['verts'][0] + subverts[2, 0, 0] = el['verts'][1] + subverts[2, 2, 0] = el['verts'][2] + subverts[0, 2, 0] = el['verts'][3] + subverts[0, 0, 2] = el['verts'][4] + subverts[2, 0, 2] = el['verts'][5] + subverts[2, 2, 2] = el['verts'][6] + subverts[0, 2, 2] = el['verts'][7] + + # lower edges + subverts[1, 0, 0] = subdivide_edge(subverts[0, 0, 0], subverts[2, 0, 0]) + subverts[2, 1, 0] = subdivide_edge(subverts[2, 0, 0], subverts[2, 2, 0]) + subverts[1, 2, 0] = subdivide_edge(subverts[2, 2, 0], subverts[0, 2, 0]) + subverts[0, 1, 0] = subdivide_edge(subverts[0, 2, 0], subverts[0, 0, 0]) + + # middle edges + subverts[0, 0, 1] = subdivide_edge(subverts[0, 0, 0], subverts[0, 0, 2]) + subverts[2, 0, 1] = subdivide_edge(subverts[2, 0, 0], subverts[2, 0, 2]) + subverts[2, 2, 1] = subdivide_edge(subverts[2, 2, 0], subverts[2, 2, 2]) + subverts[0, 2, 1] = subdivide_edge(subverts[0, 2, 0], subverts[0, 2, 2]) + + # top edges + subverts[1, 0, 2] = subdivide_edge(subverts[0, 0, 2], subverts[2, 0, 2]) + subverts[2, 1, 2] = subdivide_edge(subverts[2, 0, 2], subverts[2, 2, 2]) + subverts[1, 2, 2] = subdivide_edge(subverts[2, 2, 2], subverts[0, 2, 2]) + subverts[0, 1, 2] = subdivide_edge(subverts[0, 2, 2], subverts[0, 0, 2]) + + # then faces... The edge_to_vert addition is due to there being two ways + # to calculate a face vertex, depending on which opposite vertices are used to subdivide. + # This way, we avoid creating duplicate vertices. + subverts[1, 1, 0] = subdivide_edge(subverts[1, 0, 0], subverts[1, 2, 0]) + edge_to_vert[ordered_pair(subverts[0, 1, 0], subverts[2, 1, 0])] = subverts[1, 1, 0] + + subverts[1, 0, 1] = subdivide_edge(subverts[1, 0, 0], subverts[1, 0, 2]) + edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[2, 0, 1])] = subverts[1, 0, 1] + + subverts[2, 1, 1] = subdivide_edge(subverts[2, 1, 0], subverts[2, 1, 2]) + edge_to_vert[ordered_pair(subverts[2, 0, 1], subverts[2, 2, 1])] = subverts[2, 1, 1] + + subverts[1, 2, 1] = subdivide_edge(subverts[1, 2, 0], subverts[1, 2, 2]) + edge_to_vert[ordered_pair(subverts[0, 2, 1], subverts[2, 2, 1])] = subverts[1, 2, 1] + + subverts[0, 1, 1] = subdivide_edge(subverts[0, 1, 0], subverts[0, 1, 2]) + edge_to_vert[ordered_pair(subverts[0, 0, 1], subverts[0, 2, 1])] = subverts[0, 1, 1] + + subverts[1, 1, 2] = subdivide_edge(subverts[1, 0, 2], subverts[1, 2, 2]) + edge_to_vert[ordered_pair(subverts[0, 1, 2], subverts[2, 1, 2])] = subverts[1, 1, 2] + + # and finally the center. There are three ways to calculate, but elements should + # not intersect, so the edge_to_vert part isn't needed here. + subverts[1, 1, 1] = subdivide_edge(subverts[1, 1, 0], subverts[1, 1, 2]) + + + # Now make the hexahedron subelements + # order in which vtk expects vertices for a hexahedron + order = np.array([(0,0,0),(1,0,0),(1,1,0),(0,1,0),(0,0,1),(1,0,1),(1,1,1),(0,1,1)]) + for z in range(2): + for y in range(2): + for x in range(2): + hex_ = vtk.vtkHexahedron() + for vert_id in range(8): + coord = order[vert_id] + (x, y, z) + # minus one, since vtk starts at zero but marc starts at one + hex_.GetPointIds().SetId(vert_id, subverts[coord[0], coord[1], coord[2]] - 1) + grid.InsertNextCell(hex_.GetCellType(), hex_.GetPointIds()) + + else: + damask.util.croak('Unsupported Marc element type: {} (skipping)'.format(el['type'])) + +# Load all points +points = vtk.vtkPoints() +for point in range(1, len(coordinates) + 1): # marc indices start at 1 + points.InsertNextPoint(coordinates[point].tolist()) + +grid.SetPoints(points) + +# grid now contains the elements from the given marc file +writer = vtk.vtkXMLUnstructuredGridWriter() +writer.SetFileName(re.sub(r'\..+', ".vtu", args.filename)) # *.vtk extension does not work in paraview + +if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(grid) +else: writer.SetInputData(grid) +writer.Write() + +if args.table is not None: + table.info_append([ + scriptID + ' ' + ' '.join(sys.argv[1:]), + ]) + table.head_write() + table.output_flush() + + table.data = np.array(nodal_data) + + table.data_writeArray() + +table.close() diff --git a/processing/post/vtk_addGridData.py b/processing/post/vtk_addGridData.py new file mode 100755 index 000000000..e0c274dc7 --- /dev/null +++ b/processing/post/vtk_addGridData.py @@ -0,0 +1,206 @@ +#!/usr/bin/env python2.7 +# -*- coding: UTF-8 no BOM -*- + +import os,vtk +import damask +from vtk.util import numpy_support +from collections import defaultdict +from optparse import OptionParser + +scriptName = os.path.splitext(os.path.basename(__file__))[0] +scriptID = ' '.join([scriptName,damask.version]) + +# -------------------------------------------------------------------- +# MAIN +# -------------------------------------------------------------------- + +msg = "Add scalars, vectors, and/or an RGB tuple from" +msg += "an ASCIItable to existing VTK grid (.vtr/.vtk/.vtu)." +parser = OptionParser(option_class=damask.extendableOption, + usage='%prog options [file[s]]', + description = msg, + version = scriptID) + +parser.add_option( '--vtk', + dest = 'vtk', + type = 'string', metavar = 'string', + help = 'VTK file name') +parser.add_option( '--inplace', + dest = 'inplace', + action = 'store_true', + help = 'modify VTK file in-place') +parser.add_option('-r', '--render', + dest = 'render', + action = 'store_true', + help = 'open output in VTK render window') +parser.add_option('-d', '--data', + dest = 'data', + action = 'extend', metavar = '', + help = 'scalar/vector value(s) label(s)') +parser.add_option('-t', '--tensor', + dest = 'tensor', + action = 'extend', metavar = '', + help = 'tensor (3x3) value label(s)') +parser.add_option('-c', '--color', + dest = 'color', + action = 'extend', metavar = '', + help = 'RGB color tuple label') + +parser.set_defaults(data = [], + tensor = [], + color = [], + inplace = False, + render = False, +) + +(options, filenames) = parser.parse_args() + +if not options.vtk: parser.error('No VTK file specified.') +if not os.path.exists(options.vtk): parser.error('VTK file does not exist.') + +if os.path.splitext(options.vtk)[1] == '.vtr': + reader = vtk.vtkXMLRectilinearGridReader() + reader.SetFileName(options.vtk) + reader.Update() + rGrid = reader.GetOutput() + writer = vtk.vtkXMLRectilinearGridWriter() + writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) +elif os.path.splitext(options.vtk)[1] == '.vtk': + reader = vtk.vtkGenericDataObjectReader() + reader.SetFileName(options.vtk) + reader.Update() + rGrid = reader.GetRectilinearGridOutput() + writer = vtk.vtkXMLRectilinearGridWriter() + writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtr' if options.inplace else '_added.vtr')) +elif os.path.splitext(options.vtk)[1] == '.vtu': + reader = vtk.vtkXMLUnstructuredGridReader() + reader.SetFileName(options.vtk) + reader.Update() + rGrid = reader.GetOutput() + writer = vtk.vtkXMLUnstructuredGridWriter() + writer.SetFileName(os.path.splitext(options.vtk)[0]+('.vtu' if options.inplace else '_added.vtu')) +else: + parser.error('Unsupported VTK file type extension.') + +Npoints = rGrid.GetNumberOfPoints() +Ncells = rGrid.GetNumberOfCells() + +damask.util.croak('{}: {} points and {} cells...'.format(options.vtk,Npoints,Ncells)) + +# --- loop over input files ------------------------------------------------------------------------- + +if filenames == []: filenames = [None] + +for name in filenames: + try: table = damask.ASCIItable(name = name, + buffered = False, + readonly = True) + except: continue + damask.util.report(scriptName, name) + +# --- interpret header ---------------------------------------------------------------------------- + + table.head_read() + + remarks = [] + errors = [] + VTKarray = {} + active = defaultdict(list) + + for datatype,dimension,label in [['data',99,options.data], + ['tensor',9,options.tensor], + ['color' ,3,options.color], + ]: + for i,dim in enumerate(table.label_dimension(label)): + me = label[i] + if dim == -1: remarks.append('{} "{}" not found...'.format(datatype,me)) + elif dim > dimension: remarks.append('"{}" not of dimension {}...'.format(me,dimension)) + else: + remarks.append('adding {} "{}"...'.format(datatype,me)) + active[datatype].append(me) + + if remarks != []: damask.util.croak(remarks) + if errors != []: + damask.util.croak(errors) + table.close(dismiss = True) + continue + +# ------------------------------------------ process data --------------------------------------- + + table.data_readArray([item for sublist in active.values() for item in sublist]) # read all requested data + + for datatype,labels in active.items(): # loop over scalar,color + for me in labels: # loop over all requested items + VTKtype = vtk.VTK_DOUBLE + VTKdata = table.data[:, table.label_indexrange(me)].copy() # copy to force contiguous layout + + if datatype == 'color': + VTKtype = vtk.VTK_UNSIGNED_CHAR + VTKdata = (VTKdata*255).astype(int) # translate to 0..255 UCHAR + elif datatype == 'tensor': + VTKdata[:,1] = VTKdata[:,3] = 0.5*(VTKdata[:,1]+VTKdata[:,3]) + VTKdata[:,2] = VTKdata[:,6] = 0.5*(VTKdata[:,2]+VTKdata[:,6]) + VTKdata[:,5] = VTKdata[:,7] = 0.5*(VTKdata[:,5]+VTKdata[:,7]) + + VTKarray[me] = numpy_support.numpy_to_vtk(num_array=VTKdata,deep=True,array_type=VTKtype) + VTKarray[me].SetName(me) + + table.close() # close input ASCII table + +# ------------------------------------------ add data --------------------------------------- + + if len(table.data) == Npoints: mode = 'point' + elif len(table.data) == Ncells: mode = 'cell' + else: + damask.util.croak('Data count is incompatible with grid...') + continue + + damask.util.croak('{} mode...'.format(mode)) + + for datatype,labels in active.items(): # loop over scalar,color + if datatype == 'color': + if mode == 'cell': rGrid.GetCellData().SetScalars(VTKarray[active['color'][0]]) + elif mode == 'point': rGrid.GetPointData().SetScalars(VTKarray[active['color'][0]]) + for me in labels: # loop over all requested items + if mode == 'cell': rGrid.GetCellData().AddArray(VTKarray[me]) + elif mode == 'point': rGrid.GetPointData().AddArray(VTKarray[me]) + + rGrid.Modified() + if vtk.VTK_MAJOR_VERSION <= 5: rGrid.Update() + +# ------------------------------------------ output result --------------------------------------- + + writer.SetDataModeToBinary() + writer.SetCompressorTypeToZLib() + if vtk.VTK_MAJOR_VERSION <= 5: writer.SetInput(rGrid) + else: writer.SetInputData(rGrid) + writer.Write() + +# ------------------------------------------ render result --------------------------------------- + +if options.render: + mapper = vtk.vtkDataSetMapper() + mapper.SetInputData(rGrid) + actor = vtk.vtkActor() + actor.SetMapper(mapper) + +# Create the graphics structure. The renderer renders into the +# render window. The render window interactor captures mouse events +# and will perform appropriate camera or actor manipulation +# depending on the nature of the events. + + ren = vtk.vtkRenderer() + + renWin = vtk.vtkRenderWindow() + renWin.AddRenderer(ren) + + ren.AddActor(actor) + ren.SetBackground(1, 1, 1) + renWin.SetSize(200, 200) + + iren = vtk.vtkRenderWindowInteractor() + iren.SetRenderWindow(renWin) + + iren.Initialize() + renWin.Render() + iren.Start() diff --git a/processing/pre/3DRVEfrom2Dang.py b/processing/pre/3DRVEfrom2Dang.py old mode 100644 new mode 100755 diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index eb1448028..eade66e17 100644 --- a/src/CMakeLists.txt +++ b/src/CMakeLists.txt @@ -74,10 +74,8 @@ add_library (PLASTIC OBJECT "plastic_disloUCLA.f90" "plastic_isotropic.f90" "plastic_phenopowerlaw.f90" - "plastic_titanmod.f90" "plastic_nonlocal.f90" - "plastic_none.f90" - "plastic_phenoplus.f90") + "plastic_none.f90") add_dependencies(PLASTIC DAMASK_HELPERS) list(APPEND OBJECTFILES $) diff --git a/src/DAMASK_spectral.f90 b/src/DAMASK_spectral.f90 index 3f6709d97..d70a818a6 100755 --- a/src/DAMASK_spectral.f90 +++ b/src/DAMASK_spectral.f90 @@ -485,8 +485,8 @@ program DAMASK_spectral min(i*((maxRealOut)/materialpoint_sizeResults),size(materialpoint_results,3))],pLongInt) call MPI_file_write(resUnit, & reshape(materialpoint_results(:,:,outputIndex(1):outputIndex(2)), & - [(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), & - (outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults, & + [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & + (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 @@ -683,8 +683,8 @@ program DAMASK_spectral 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)),& - [(outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults]), & - (outputIndex(2)-outputIndex(1)+1)*materialpoint_sizeResults,& + [(outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt)]), & + (outputIndex(2)-outputIndex(1)+1)*int(materialpoint_sizeResults,pLongInt),& MPI_DOUBLE, MPI_STATUS_IGNORE, ierr) if(ierr /=0_pInt) call IO_error(894_pInt, ext_msg='MPI_file_write') enddo @@ -831,10 +831,10 @@ subroutine quit(stop_id) call utilities_destroy() call PETScFinalize(ierr) - if(ierr /= 0) write(6,'(a)') ' Error in PETScFinalize' + if (ierr /= 0) write(6,'(a)') ' Error in PETScFinalize' #ifdef _OPENMP call MPI_finalize(error) - if(error /= 0) write(6,'(a)') ' Error in MPI_finalize' + if (error /= 0) write(6,'(a)') ' Error in MPI_finalize' #endif ErrorInQuit = (ierr /= 0 .or. error /= 0_pInt) @@ -848,7 +848,7 @@ subroutine quit(stop_id) dateAndTime(7) if (stop_id == 0_pInt .and. .not. ErrorInQuit) stop 0 ! normal termination - if (stop_id < 0_pInt .and. .not. ErrorInQuit) then ! terminally ill, restart might help + if (stop_id < 0_pInt .and. .not. ErrorInQuit) then ! terminally ill, restart might help write(0,'(a,i6)') 'restart information available at ', stop_id*(-1_pInt) stop 2 endif diff --git a/src/IO.f90 b/src/IO.f90 index 224fad8c4..d877379c7 100644 --- a/src/IO.f90 +++ b/src/IO.f90 @@ -9,7 +9,7 @@ module IO use prec, only: & pInt, & pReal - + implicit none private character(len=5), parameter, public :: & @@ -50,6 +50,7 @@ module IO IO_skipChunks, & IO_extractValue, & IO_countDataLines, & + IO_countNumericalDataLines, & IO_countContinuousIntValues, & IO_continuousIntValues, & IO_error, & @@ -61,7 +62,7 @@ module IO IO_open_inputFile, & IO_open_logFile #endif -#ifdef Abaqus +#ifdef Abaqus public :: & IO_abaqus_hasNoPart #endif @@ -69,7 +70,7 @@ module IO IO_fixedFloatValue, & IO_verifyFloatValue, & IO_verifyIntValue -#ifdef Abaqus +#ifdef Abaqus private :: & abaqus_assembleInputFile #endif @@ -86,7 +87,7 @@ subroutine IO_init compiler_version, & compiler_options #endif - + implicit none write(6,'(/,a)') ' <<<+- IO init -+>>>' @@ -101,7 +102,7 @@ end subroutine IO_init !! Recursion is triggered by "{path/to/inputfile}" in a line !-------------------------------------------------------------------------------------------------- recursive function IO_read(fileUnit,reset) result(line) - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical, intent(in), optional :: reset @@ -131,7 +132,7 @@ recursive function IO_read(fileUnit,reset) result(line) unitOn(1) = fileUnit read(unitOn(stack),'(a65536)',END=100) line - + input = IO_getTag(line,'{','}') !-------------------------------------------------------------------------------------------------- @@ -139,7 +140,7 @@ recursive function IO_read(fileUnit,reset) result(line) if (input == '') return ! regular line !-------------------------------------------------------------------------------------------------- -! recursion case +! recursion case if (stack >= 10_pInt) call IO_error(104_pInt,ext_msg=input) ! recursion limit reached inquire(UNIT=unitOn(stack),NAME=path) ! path of current file @@ -154,9 +155,9 @@ recursive function IO_read(fileUnit,reset) result(line) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=pathOn(stack)) line = IO_read(fileUnit) - + return - + !-------------------------------------------------------------------------------------------------- ! end of file case 100 if (stack > 1_pInt) then ! can go back to former file @@ -175,13 +176,13 @@ end function IO_read !! error message !-------------------------------------------------------------------------------------------------- subroutine IO_checkAndRewind(fileUnit) - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit logical :: fileOpened character(len=15) :: fileRead - inquire(unit=fileUnit, opened=fileOpened, read=fileRead) + inquire(unit=fileUnit, opened=fileOpened, read=fileRead) if (.not. fileOpened .or. trim(fileRead)/='YES') call IO_error(102_pInt) rewind(fileUnit) @@ -189,7 +190,7 @@ end subroutine IO_checkAndRewind !-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. Path to file is relative to working +!> @brief opens existing file for reading to given unit. Path to file is relative to working !! directory !> @details like IO_open_file_stat, but error is handled via call to IO_error and not via return !! value @@ -197,47 +198,47 @@ end subroutine IO_checkAndRewind subroutine IO_open_file(fileUnit,relPath) use DAMASK_interface, only: & getSolverWorkingDirectoryName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: relPath !< relative path from working directory integer(pInt) :: myStat character(len=1024) :: path - + path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_open_file !-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. Path to file is relative to working +!> @brief opens existing file for reading to given unit. Path to file is relative to working !! 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 - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: relPath !< relative path from working directory integer(pInt) :: myStat character(len=1024) :: path - + path = trim(getSolverWorkingDirectoryName())//relPath open(fileUnit,status='old',iostat=myStat,file=path) IO_open_file_stat = (myStat == 0_pInt) - + end function IO_open_file_stat !-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. File is named after solver job name -!! plus given extension and located in current working directory +!> @brief opens existing file for reading to given unit. File is named after solver job name +!! plus given extension and located in current working directory !> @details like IO_open_jobFile_stat, but error is handled via call to IO_error and not via return !! value !-------------------------------------------------------------------------------------------------- @@ -256,14 +257,14 @@ subroutine IO_open_jobFile(fileUnit,ext) path = trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())//'.'//ext open(fileUnit,status='old',iostat=myStat,file=path) if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_open_jobFile !-------------------------------------------------------------------------------------------------- -!> @brief opens existing file for reading to given unit. File is named after solver job name -!! plus given extension and located in current working directory -!> @details Like IO_open_jobFile, but error is handled via return value and not via call to +!> @brief opens existing file for reading to given unit. File is named after solver job name +!! plus given extension and located in current working directory +!> @details Like IO_open_jobFile, but error is handled via return value and not via call to !! IO_error !-------------------------------------------------------------------------------------------------- logical function IO_open_jobFile_stat(fileUnit,ext) @@ -303,7 +304,7 @@ subroutine IO_open_inputFile(fileUnit,modelName) character(len=1024) :: path #ifdef Abaqus 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) @@ -313,12 +314,12 @@ subroutine IO_open_inputFile(fileUnit,modelName) open(fileUnit+1,status='old',iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + path = trim(getSolverWorkingDirectoryName())//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) + close(fileUnit+1_pInt) #endif #ifdef Marc4DAMASK path = trim(getSolverWorkingDirectoryName())//trim(modelName)//inputFileExtension @@ -330,8 +331,8 @@ end subroutine IO_open_inputFile !-------------------------------------------------------------------------------------------------- -!> @brief opens existing FEM log file for reading to given unit. File is named after solver job -!! name and located in current working directory +!> @brief opens existing FEM log file for reading to given unit. File is named after solver job +!! name and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_open_logFile(fileUnit) use DAMASK_interface, only: & @@ -354,14 +355,14 @@ end subroutine IO_open_logFile !-------------------------------------------------------------------------------------------------- -!> @brief opens ASCII file to given unit for writing. File is named after solver job name plus +!> @brief opens ASCII file to given unit for writing. File is named after solver job name plus !! given extension and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobFile(fileUnit,ext) use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -372,19 +373,19 @@ subroutine IO_write_jobFile(fileUnit,ext) path = trim(getSolverWorkingDirectoryName())//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) - + end subroutine IO_write_jobFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is +!> @brief opens binary file containing array of pReal numbers to given unit for writing. File is !! named after solver job name plus given extension and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) - use DAMASK_interface, only: & + use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -403,19 +404,19 @@ subroutine IO_write_jobRealFile(fileUnit,ext,recMultiplier) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_write_jobRealFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is +!> @brief opens binary file containing array of pInt numbers to given unit for writing. File is !! named after solver job name plus given extension and located in current working directory !-------------------------------------------------------------------------------------------------- subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) use DAMASK_interface, only: & getSolverWorkingDirectoryName, & getSolverJobName - + implicit none integer(pInt), intent(in) :: fileUnit !< file unit character(len=*), intent(in) :: ext !< extension of file @@ -434,21 +435,21 @@ subroutine IO_write_jobIntFile(fileUnit,ext,recMultiplier) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_write_jobIntFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is +!> @brief opens binary file containing array of pReal numbers to given unit for reading. File is !! 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 - character(len=*), intent(in) :: ext, & !< extension of file + character(len=*), intent(in) :: ext, & !< extension of file modelName !< model name, in case of restart not solver job name integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) @@ -457,28 +458,28 @@ subroutine IO_read_realFile(fileUnit,ext,modelName,recMultiplier) path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext if (present(recMultiplier)) then - open(fileUnit,status='old',form='unformatted',access='direct', & + open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal*recMultiplier,iostat=myStat,file=path) else open(fileUnit,status='old',form='unformatted',access='direct', & recl=pReal,iostat=myStat,file=path) endif if (myStat /= 0_pInt) call IO_error(100_pInt,el=myStat,ext_msg=path) - + end subroutine IO_read_realFile !-------------------------------------------------------------------------------------------------- -!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is +!> @brief opens binary file containing array of pInt numbers to given unit for reading. File is !! 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 - character(len=*), intent(in) :: ext, & !< extension of file + character(len=*), intent(in) :: ext, & !< extension of file modelName !< model name, in case of restart not solver job name integer(pInt), intent(in), optional :: recMultiplier !< record length (multiple of pReal Numbers, if not given set to one) @@ -487,14 +488,14 @@ subroutine IO_read_intFile(fileUnit,ext,modelName,recMultiplier) path = trim(getSolverWorkingDirectoryName())//trim(modelName)//'.'//ext if (present(recMultiplier)) then - open(fileUnit,status='old',form='unformatted',access='direct', & + open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt*recMultiplier,iostat=myStat,file=path) else open(fileUnit,status='old',form='unformatted',access='direct', & recl=pInt,iostat=myStat,file=path) endif if (myStat /= 0) call IO_error(100_pInt,ext_msg=path) - + end subroutine IO_read_intFile @@ -509,9 +510,9 @@ logical function IO_abaqus_hasNoPart(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line - + IO_abaqus_hasNoPart = .true. - + 610 FORMAT(A65536) rewind(fileUnit) do @@ -522,7 +523,7 @@ logical function IO_abaqus_hasNoPart(fileUnit) exit endif enddo - + 620 end function IO_abaqus_hasNoPart #endif @@ -537,7 +538,7 @@ function IO_hybridIA(Nast,ODFfileName) integer(pInt), intent(in) :: Nast !< number of samples? real(pReal), dimension(3,Nast) :: IO_hybridIA character(len=*), intent(in) :: ODFfileName !< name of ODF file including total path - + !-------------------------------------------------------------------------------------------------- ! math module is not available real(pReal), parameter :: PI = 3.141592653589793_pReal @@ -561,7 +562,7 @@ function IO_hybridIA(Nast,ODFfileName) write(6,'(/,a,/)',advance='no') ' Using linear ODF file: '//trim(ODFfileName) !-------------------------------------------------------------------------------------------------- -! parse header of ODF file +! parse header of ODF file call IO_open_file(FILEUNIT,ODFfileName) headerLength = 0_pInt line=IO_read(FILEUNIT) @@ -579,7 +580,7 @@ function IO_hybridIA(Nast,ODFfileName) line=IO_read(FILEUNIT) enddo columns = 0_pInt - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) do i = 1_pInt, chunkPos(1) select case ( IO_lc(IO_StringValue(line,chunkPos,i,.true.)) ) case ('phi1') @@ -603,7 +604,7 @@ function IO_hybridIA(Nast,ODFfileName) line=IO_read(FILEUNIT) do while (trim(line) /= IO_EOF) - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) eulers=[IO_floatValue(line,chunkPos,columns(1)),& IO_floatValue(line,chunkPos,columns(2)),& IO_floatValue(line,chunkPos,columns(3))] @@ -646,7 +647,7 @@ function IO_hybridIA(Nast,ODFfileName) do phi1=1_pInt,steps(1); do Phi=1_pInt,steps(2); do phi2=1_pInt,steps(3) line=IO_read(FILEUNIT) - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) eulers=[IO_floatValue(line,chunkPos,columns(1)),& ! read in again for consistency check only IO_floatValue(line,chunkPos,columns(2)),& IO_floatValue(line,chunkPos,columns(3))]*INRAD @@ -661,16 +662,16 @@ function IO_hybridIA(Nast,ODFfileName) prob = 0.0_pReal endif dV_V(phi2,Phi,phi1) = prob*dg_0*sin((real(Phi-1_pInt,pReal)+center)*deltas(2)) - enddo; enddo; enddo + enddo; enddo; enddo close(FILEUNIT) dV_V = dV_V/sum_dV_V ! normalize to 1 - + !-------------------------------------------------------------------------------------------------- ! now fix bounds Nset = max(Nast,NnonZero) ! if less than non-zero voxel count requested, sample at least that much lowerC = 0.0_pReal upperC = real(Nset, pReal) - + do while (hybridIA_reps(dV_V,steps,upperC) < Nset) lowerC = upperC upperC = upperC*2.0_pReal @@ -717,25 +718,25 @@ function IO_hybridIA(Nast,ODFfileName) IO_hybridIA(3,i) = deltas(3)*(real(mod(bin ,steps(3)),pReal)+center) ! phi2 binSet(j) = binSet(i) enddo - + contains !-------------------------------------------------------------------------------------------------- !> @brief counts hybrid IA repetitions !-------------------------------------------------------------------------------------------------- integer(pInt) pure function hybridIA_reps(dV_V,steps,C) - + implicit none integer(pInt), intent(in), dimension(3) :: steps !< number of bins in Euler space real(pReal), intent(in), dimension(steps(3),steps(2),steps(1)) :: dV_V !< needs description real(pReal), intent(in) :: C !< needs description - + integer(pInt) :: phi1,Phi,phi2 - + hybridIA_reps = 0_pInt do phi1=1_pInt,steps(1); do Phi =1_pInt,steps(2); do phi2=1_pInt,steps(3) hybridIA_reps = hybridIA_reps+nint(C*dV_V(phi2,Phi,phi1), pInt) enddo; enddo; enddo - + end function hybridIA_reps end function IO_hybridIA @@ -753,11 +754,11 @@ logical pure function IO_isBlank(string) character(len=*), parameter :: comment = achar(35) ! comment id '#' integer :: posNonBlank, posComment ! no pInt - + posNonBlank = verify(string,blankChar) posComment = scan(string,comment) IO_isBlank = posNonBlank == 0 .or. posNonBlank == posComment - + end function IO_isBlank @@ -769,8 +770,8 @@ pure function IO_getTag(string,openChar,closeChar) implicit none 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 + + character(len=*), 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 @@ -780,7 +781,7 @@ pure function IO_getTag(string,openChar,closeChar) IO_getTag = '' left = scan(string,openChar) right = scan(string,closeChar) - + if (left == verify(string,SEP) .and. right > left) & ! openChar is first and closeChar occurs IO_getTag = string(left+1:right-1) @@ -793,7 +794,7 @@ end function IO_getTag integer(pInt) function IO_countSections(fileUnit,part) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*), intent(in) :: part !< part name in which sections are counted character(len=65536) :: line @@ -811,14 +812,14 @@ integer(pInt) function IO_countSections(fileUnit,part) 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 + 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] @@ -828,7 +829,7 @@ 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 + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for @@ -837,12 +838,12 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) :: section character(len=65536) :: line - + line = '' counter = 0_pInt section = 0_pInt - rewind(fileUnit) + rewind(fileUnit) do while (trim(line) /= IO_EOF .and. IO_lc(IO_getTag(line,'<','>')) /= part) ! search for part line = IO_read(fileUnit) enddo @@ -852,14 +853,14 @@ function IO_countTagInPart(fileUnit,part,tag,Nsections) 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 + 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 + endif enddo IO_countTagInPart = counter @@ -875,7 +876,7 @@ 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 + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for @@ -898,11 +899,11 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) 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 + exit endif if (IO_getTag(line,'[',']') /= '') section = section + 1_pInt ! found [section] identifier if (section > 0_pInt) then - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) if (tag == trim(IO_lc(IO_stringValue(line,chunkPos,1_pInt)))) & ! match IO_spotTagInPart(section) = .true. endif @@ -917,7 +918,7 @@ function IO_spotTagInPart(fileUnit,part,tag,Nsections) logical function IO_globalTagInPart(fileUnit,part,tag) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), intent(in) :: fileUnit !< file handle character(len=*),intent(in) :: part, & !< part in which tag is searched for tag !< tag to search for @@ -940,21 +941,21 @@ logical function IO_globalTagInPart(fileUnit,part,tag) 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 + exit endif 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_globalTagInPart = .true. - endif + endif enddo end function IO_globalTagInPart !-------------------------------------------------------------------------------------------------- -!> @brief locates all space-separated chunks in given string and returns array containing number +!> @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 !! Array size is dynamically adjusted to number of chunks found in string !! IMPORTANT: first element contains number of chunks! @@ -964,13 +965,13 @@ pure function IO_stringPos(string) implicit none integer(pInt), dimension(:), allocatable :: IO_stringPos character(len=*), intent(in) :: string !< string in which chunk positions are searched for - + character(len=*), parameter :: SEP=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces integer :: left, right ! no pInt (verify and scan return default integer) allocate(IO_stringPos(1), source=0_pInt) right = 0 - + do while (verify(string(right+1:),SEP)>0) left = right + verify(string(right+1:),SEP) right = left + scan(string(left:),SEP) - 2 @@ -986,7 +987,7 @@ end function IO_stringPos !> @brief reads string value at myChunk from string !-------------------------------------------------------------------------------------------------- function IO_stringValue(string,chunkPos,myChunk,silent) - + 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 @@ -997,13 +998,13 @@ function IO_stringValue(string,chunkPos,myChunk,silent) character(len=16), parameter :: MYNAME = 'IO_stringValue: ' logical :: warn - + if (.not. present(silent)) then warn = .false. else warn = silent endif - + IO_stringValue = '' valuePresent: if (myChunk > chunkPos(1) .or. myChunk < 1_pInt) then if (warn) call IO_warning(201,el=myChunk,ext_msg=MYNAME//trim(string)) @@ -1018,11 +1019,11 @@ end function IO_stringValue !> @brief reads string value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- pure function IO_fixedStringValue (string,ends,myChunk) - + implicit none integer(pInt), intent(in) :: myChunk !< position number of desired chunk integer(pInt), dimension(:), intent(in) :: ends !< positions of end of each tag/chunk in given string - character(len=ends(myChunk+1)-ends(myChunk)) :: IO_fixedStringValue + character(len=ends(myChunk+1)-ends(myChunk)) :: IO_fixedStringValue character(len=*), intent(in) :: string !< raw input with known ends of each chunk IO_fixedStringValue = string(ends(myChunk)+1:ends(myChunk+1)) @@ -1059,7 +1060,7 @@ end function IO_floatValue !> @brief reads float value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- real(pReal) function IO_fixedFloatValue (string,ends,myChunk) - + implicit none character(len=*), intent(in) :: string !< raw input with known ends of each chunk integer(pInt), intent(in) :: myChunk !< position number of desired chunk @@ -1086,11 +1087,11 @@ real(pReal) function IO_fixedNoEFloatValue (string,ends,myChunk) character(len=22), parameter :: MYNAME = 'IO_fixedNoEFloatValue ' character(len=13), parameter :: VALIDBASE = '0123456789.+-' character(len=12), parameter :: VALIDEXP = '0123456789+-' - + real(pReal) :: base integer(pInt) :: expon integer :: pos_exp - + pos_exp = scan(string(ends(myChunk)+1:ends(myChunk+1)),'+-',back=.true.) hasExponent: if (pos_exp > 1) then base = IO_verifyFloatValue(trim(adjustl(string(ends(myChunk)+1_pInt:ends(myChunk)+pos_exp-1_pInt))),& @@ -1135,7 +1136,7 @@ end function IO_intValue !> @brief reads integer value at myChunk from fixed format string !-------------------------------------------------------------------------------------------------- integer(pInt) function IO_fixedIntValue(string,ends,myChunk) - + implicit none character(len=*), intent(in) :: string !< raw input with known ends of each chunk integer(pInt), intent(in) :: myChunk !< position number of desired chunk @@ -1159,8 +1160,8 @@ pure function IO_lc(string) character(len=len(string)) :: IO_lc character(26), parameter :: LOWER = 'abcdefghijklmnopqrstuvwxyz' - character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - + character(26), parameter :: UPPER = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + integer :: i,n ! no pInt (len returns default integer) IO_lc = string @@ -1178,8 +1179,8 @@ end function IO_lc subroutine IO_skipChunks(fileUnit,N) implicit none - integer(pInt), intent(in) :: fileUnit, & !< file handle - N !< minimum number of chunks to skip + integer(pInt), intent(in) :: fileUnit, & !< file handle + N !< minimum number of chunks to skip integer(pInt) :: remainingChunks character(len=65536) :: line @@ -1198,7 +1199,7 @@ end subroutine IO_skipChunks !> @brief extracts string value from key=value pair and check whether key matches !-------------------------------------------------------------------------------------------------- character(len=300) pure function IO_extractValue(pair,key) - + implicit none character(len=*), intent(in) :: pair, & !< key=value pair key !< key to be expected @@ -1221,8 +1222,8 @@ end function IO_extractValue integer(pInt) function IO_countDataLines(fileUnit) implicit none - integer(pInt), intent(in) :: fileUnit !< file handle - + integer(pInt), intent(in) :: fileUnit !< file handle + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line, & @@ -1236,7 +1237,7 @@ integer(pInt) function IO_countDataLines(fileUnit) chunkPos = IO_stringPos(line) tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) if (tmp(1:1) == '*' .and. tmp(2:2) /= '*') then ! found keyword - line = IO_read(fileUnit, .true.) ! reset IO_read + line = IO_read(fileUnit, .true.) ! reset IO_read exit else if (tmp(2:2) /= '*') IO_countDataLines = IO_countDataLines + 1_pInt @@ -1246,7 +1247,38 @@ integer(pInt) function IO_countDataLines(fileUnit) end function IO_countDataLines - + +!-------------------------------------------------------------------------------------------------- +!> @brief count lines containig data up to next *keyword +!-------------------------------------------------------------------------------------------------- +integer(pInt) function IO_countNumericalDataLines(fileUnit) + + implicit none + integer(pInt), intent(in) :: fileUnit !< file handle + + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=65536) :: line, & + tmp + + IO_countNumericalDataLines = 0_pInt + line = '' + + do while (trim(line) /= IO_EOF) + line = IO_read(fileUnit) + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp) ,"0123456789")/=0) then ! found keyword + line = IO_read(fileUnit, .true.) ! reset IO_read + exit + else + IO_countNumericalDataLines = IO_countNumericalDataLines + 1_pInt + endif + enddo + backspace(fileUnit) + +end function IO_countNumericalDataLines + !-------------------------------------------------------------------------------------------------- !> @brief count items in consecutive lines depending on lines !> @details Marc: ints concatenated by "c" as last char or range of values a "to" b @@ -1257,8 +1289,8 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - -#ifdef Abaqus + +#ifdef Abaqus integer(pInt) :: l,c #endif integer(pInt), allocatable, dimension(:) :: chunkPos @@ -1272,22 +1304,22 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) line = IO_read(fileUnit) chunkPos = IO_stringPos(line) if (chunkPos(1) < 1_pInt) then ! empty line - line = IO_read(fileUnit, .true.) ! reset IO_read + line = IO_read(fileUnit, .true.) ! reset IO_read exit elseif (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator IO_countContinuousIntValues = 1_pInt + abs( IO_intValue(line,chunkPos,3_pInt) & - IO_intValue(line,chunkPos,1_pInt)) - line = IO_read(fileUnit, .true.) ! reset IO_read + line = IO_read(fileUnit, .true.) ! reset IO_read exit ! only one single range indicator allowed else if (IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'of' ) then ! found multiple entries indicator IO_countContinuousIntValues = IO_intValue(line,chunkPos,1_pInt) - line = IO_read(fileUnit, .true.) ! reset IO_read + line = IO_read(fileUnit, .true.) ! reset IO_read exit ! only one single multiplier allowed else IO_countContinuousIntValues = IO_countContinuousIntValues+chunkPos(1)-1_pInt ! add line's count when assuming 'c' if ( IO_lc(IO_stringValue(line,chunkPos,chunkPos(1))) /= 'c' ) then ! line finished, read last value IO_countContinuousIntValues = IO_countContinuousIntValues+1_pInt - line = IO_read(fileUnit, .true.) ! reset IO_read + line = IO_read(fileUnit, .true.) ! reset IO_read exit ! data ended endif endif @@ -1297,7 +1329,7 @@ integer(pInt) function IO_countContinuousIntValues(fileUnit) do l = 1_pInt,c backspace(fileUnit) ! ToDo: substitute by rewind? enddo - + l = 1_pInt do while (trim(line) /= IO_EOF .and. l <= c) ! ToDo: is this correct l = l + 1_pInt @@ -1313,7 +1345,7 @@ end function IO_countContinuousIntValues !-------------------------------------------------------------------------------------------------- -!> @brief return integer list corrsponding to items in consecutive lines. +!> @brief return integer list corresponding to items in consecutive lines. !! First integer in array is counter !> @details Marc: ints concatenated by "c" as last char, range of a "to" b, or named set !! Abaqus: triplet of start,stop,inc or named set @@ -1324,7 +1356,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) implicit none integer(pInt), intent(in) :: maxN integer(pInt), dimension(1+maxN) :: IO_continuousIntValues - + integer(pInt), intent(in) :: fileUnit, & lookupMaxN integer(pInt), dimension(:,:), intent(in) :: lookupMap @@ -1358,7 +1390,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) else if (chunkPos(1) > 2_pInt .and. IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'to' ) then ! found range indicator first = IO_intValue(line,chunkPos,1_pInt) last = IO_intValue(line,chunkPos,3_pInt) - do i = first, last, sign(1_pInt,last-first) + do i = first, last, sign(1_pInt,last-first) IO_continuousIntValues(1) = IO_continuousIntValues(1) + 1_pInt IO_continuousIntValues(1+IO_continuousIntValues(1)) = i enddo @@ -1384,7 +1416,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) do l = 1_pInt,c backspace(fileUnit) enddo - + !-------------------------------------------------------------------------------------------------- ! check if the element values in the elset are auto generated backspace(fileUnit) @@ -1393,7 +1425,7 @@ function IO_continuousIntValues(fileUnit,maxN,lookupName,lookupMap,lookupMaxN) do i = 1_pInt,chunkPos(1) if (IO_lc(IO_stringValue(line,chunkPos,i)) == 'generate') rangeGeneration = .true. enddo - + do l = 1_pInt,c read(fileUnit,'(A65536)',end=100) line chunkPos = IO_stringPos(line) @@ -1436,7 +1468,7 @@ pure function IO_intOut(intToPrint) character(len=19) :: N_Digits ! maximum digits for 64 bit integer character(len=40) :: IO_intOut integer(pInt), intent(in) :: intToPrint - + write(N_Digits, '(I19.19)') 1_pInt + int(log10(real(intToPrint)),pInt) IO_intOut = 'I'//trim(N_Digits)//'.'//trim(N_Digits) @@ -1451,7 +1483,7 @@ function IO_timeStamp() implicit none character(len=10) :: IO_timeStamp integer(pInt), dimension(8) :: values - + call DATE_AND_TIME(VALUES=values) write(IO_timeStamp,'(i2.2,a1,i2.2,a1,i2.2)') values(5),':',values(6),':',values(7) @@ -1468,11 +1500,11 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) integer(pInt), intent(in) :: error_ID integer(pInt), optional, intent(in) :: el,ip,g,instance character(len=*), optional, intent(in) :: ext_msg - + external :: quit character(len=1024) :: msg character(len=1024) :: formatString - + select case (error_ID) !-------------------------------------------------------------------------------------------------- @@ -1494,7 +1526,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = '{input} recursion limit reached' case (105_pInt) msg = 'unknown output:' - + !-------------------------------------------------------------------------------------------------- ! lattice error messages case (130_pInt) @@ -1540,7 +1572,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) !-------------------------------------------------------------------------------------------------- ! plasticity error messages case (200_pInt) - msg = 'unknown elasticity specified:' + msg = 'unknown elasticity specified:' case (201_pInt) msg = 'unknown plasticity specified:' @@ -1550,12 +1582,12 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'material parameter out of bounds:' !-------------------------------------------------------------------------------------------------- -! numerics error messages +! numerics error messages case (300_pInt) msg = 'unknown numerics parameter:' case (301_pInt) msg = 'numerics parameter out of bounds:' - + !-------------------------------------------------------------------------------------------------- ! math errors case (400_pInt) @@ -1577,7 +1609,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) ! homogenization errors case (500_pInt) msg = 'unknown homogenization specified' - + !-------------------------------------------------------------------------------------------------- ! user errors case (600_pInt) @@ -1638,7 +1670,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'PETSc: SNES_DIVERGED_FNORM_NAN' case (894_pInt) msg = 'MPI error' - + !------------------------------------------------------------------------------------------------- ! error messages related to parsing of Abaqus input file case (900_pInt) @@ -1660,9 +1692,9 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) case (908_pInt) msg = 'size of mesh_mapFEtoCPnode in mesh_abaqus_map_nodes' case (909_pInt) - msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' - - + msg = 'size of mesh_node in mesh_abaqus_build_nodes not equal to mesh_Nnodes' + + !------------------------------------------------------------------------------------------------- ! general error messages case (666_pInt) @@ -1671,7 +1703,7 @@ subroutine IO_error(error_ID,el,ip,g,instance,ext_msg) msg = 'unknown error number...' end select - + !$OMP CRITICAL (write2out) write(0,'(/,a)') ' ┌'//IO_DIVIDER//'┐' write(0,'(a,24x,a,40x,a)') ' │','error', '│' @@ -1711,7 +1743,7 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) integer(pInt), intent(in) :: warning_ID integer(pInt), optional, intent(in) :: el,ip,g character(len=*), optional, intent(in) :: ext_msg - + character(len=1024) :: msg character(len=1024) :: formatString @@ -1759,7 +1791,7 @@ subroutine IO_warning(warning_ID,el,ip,g,ext_msg) case default msg = 'unknown warning number' end select - + !$OMP CRITICAL (write2out) write(6,'(/,a)') ' ┌'//IO_DIVIDER//'┐' write(6,'(a,24x,a,38x,a)') ' │','warning', '│' @@ -1788,34 +1820,34 @@ end subroutine IO_warning !-------------------------------------------------------------------------------------------------- -! internal helper functions +! internal helper functions !-------------------------------------------------------------------------------------------------- !> @brief returns verified integer value in given string !-------------------------------------------------------------------------------------------------- integer(pInt) function IO_verifyIntValue (string,validChars,myName) - + implicit none - character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! + character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! validChars, & !< valid characters in string myName !< name of caller function (for debugging) integer(pInt) :: readStatus, invalidWhere !character(len=len(trim(string))) :: trimmed does not work with ifort 14.0.1 - + IO_verifyIntValue = 0_pInt invalidWhere = verify(string,validChars) if (invalidWhere == 0_pInt) then read(UNIT=string,iostat=readStatus,FMT=*) IO_verifyIntValue ! no offending chars found - if (readStatus /= 0_pInt) & ! error during string to float conversion + if (readStatus /= 0_pInt) & ! error during string to integer conversion call IO_warning(203_pInt,ext_msg=myName//'"'//string//'"') else call IO_warning(202_pInt,ext_msg=myName//'"'//string//'"') ! complain about offending characters read(UNIT=string(1_pInt:invalidWhere-1_pInt),iostat=readStatus,FMT=*) IO_verifyIntValue ! interpret remaining string - if (readStatus /= 0_pInt) & ! error during string to float conversion + if (readStatus /= 0_pInt) & ! error during string to integer conversion call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"') endif - + end function IO_verifyIntValue @@ -1823,15 +1855,15 @@ end function IO_verifyIntValue !> @brief returns verified float value in given string !-------------------------------------------------------------------------------------------------- real(pReal) function IO_verifyFloatValue (string,validChars,myName) - + implicit none - character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! + character(len=*), intent(in) :: string, & !< string for conversion to int value. Must not contain spaces! validChars, & !< valid characters in string myName !< name of caller function (for debugging) integer(pInt) :: readStatus, invalidWhere !character(len=len(trim(string))) :: trimmed does not work with ifort 14.0.1 - + IO_verifyFloatValue = 0.0_pReal invalidWhere = verify(string,validChars) @@ -1845,12 +1877,12 @@ real(pReal) function IO_verifyFloatValue (string,validChars,myName) if (readStatus /= 0_pInt) & ! error during string to float conversion call IO_warning(203_pInt,ext_msg=myName//'"'//string(1_pInt:invalidWhere-1_pInt)//'"') endif - + end function IO_verifyFloatValue - -#ifdef Abaqus + +#ifdef Abaqus !-------------------------------------------------------------------------------------------------- -!> @brief create a new input file for abaqus simulations by removing all comment lines and +!> @brief create a new input file for abaqus simulations by removing all comment lines and !> including "include"s !-------------------------------------------------------------------------------------------------- recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) @@ -1860,7 +1892,7 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) implicit none integer(pInt), intent(in) :: unit1, & unit2 - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=65536) :: line,fname @@ -1894,10 +1926,10 @@ recursive function abaqus_assembleInputFile(unit1,unit2) result(createSuccess) write(unit1,'(A)') trim(line) endif enddo - + 220 createSuccess = .true. return - + 200 createSuccess =.false. end function abaqus_assembleInputFile diff --git a/src/commercialFEM_fileList.f90 b/src/commercialFEM_fileList.f90 index 7b95490b0..51848ece5 100644 --- a/src/commercialFEM_fileList.f90 +++ b/src/commercialFEM_fileList.f90 @@ -28,8 +28,6 @@ #include "plastic_none.f90" #include "plastic_isotropic.f90" #include "plastic_phenopowerlaw.f90" -#include "plastic_phenoplus.f90" -#include "plastic_titanmod.f90" #include "plastic_dislotwin.f90" #include "plastic_disloUCLA.f90" #include "plastic_nonlocal.f90" diff --git a/src/constitutive.f90 b/src/constitutive.f90 index ec9c7fdef..f124e545b 100644 --- a/src/constitutive.f90 +++ b/src/constitutive.f90 @@ -74,10 +74,8 @@ subroutine constitutive_init() PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID ,& SOURCE_thermal_dissipation_ID, & SOURCE_thermal_externalheat_ID, & @@ -97,10 +95,8 @@ subroutine constitutive_init() PLASTICITY_NONE_label, & PLASTICITY_ISOTROPIC_label, & PLASTICITY_PHENOPOWERLAW_label, & - PLASTICITY_PHENOPLUS_label, & PLASTICITY_DISLOTWIN_label, & PLASTICITY_DISLOUCLA_label, & - PLASTICITY_TITANMOD_label, & PLASTICITY_NONLOCAL_label, & SOURCE_thermal_dissipation_label, & SOURCE_thermal_externalheat_label, & @@ -117,10 +113,8 @@ subroutine constitutive_init() use plastic_none use plastic_isotropic use plastic_phenopowerlaw - use plastic_phenoplus use plastic_dislotwin use plastic_disloucla - use plastic_titanmod use plastic_nonlocal use source_thermal_dissipation use source_thermal_externalheat @@ -162,10 +156,8 @@ subroutine constitutive_init() if (any(phase_plasticity == PLASTICITY_NONE_ID)) call plastic_none_init if (any(phase_plasticity == PLASTICITY_ISOTROPIC_ID)) call plastic_isotropic_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_PHENOPOWERLAW_ID)) call plastic_phenopowerlaw_init(FILEUNIT) - if (any(phase_plasticity == PLASTICITY_PHENOPLUS_ID)) call plastic_phenoplus_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) - if (any(phase_plasticity == PLASTICITY_TITANMOD_ID)) call plastic_titanmod_init(FILEUNIT) if (any(phase_plasticity == PLASTICITY_NONLOCAL_ID)) then call plastic_nonlocal_init(FILEUNIT) call plastic_nonlocal_stateInit() @@ -194,11 +186,11 @@ subroutine constitutive_init() if (any(phase_kinematics == KINEMATICS_hydrogen_strain_ID)) call kinematics_hydrogen_strain_init(FILEUNIT) close(FILEUNIT) - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- constitutive init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- constitutive init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" + mainProcess: if (worldrank == 0) then !-------------------------------------------------------------------------------------------------- ! write description file for constitutive output call IO_write_jobFile(FILEUNIT,'outputConstitutive') @@ -222,11 +214,6 @@ subroutine constitutive_init() thisNoutput => plastic_phenopowerlaw_Noutput thisOutput => plastic_phenopowerlaw_output thisSize => plastic_phenopowerlaw_sizePostResult - case (PLASTICITY_PHENOPLUS_ID) plasticityType - outputName = PLASTICITY_PHENOPLUS_label - thisNoutput => plastic_phenoplus_Noutput - thisOutput => plastic_phenoplus_output - thisSize => plastic_phenoplus_sizePostResult case (PLASTICITY_DISLOTWIN_ID) plasticityType outputName = PLASTICITY_DISLOTWIN_label thisNoutput => plastic_dislotwin_Noutput @@ -237,11 +224,6 @@ subroutine constitutive_init() thisNoutput => plastic_disloucla_Noutput thisOutput => plastic_disloucla_output thisSize => plastic_disloucla_sizePostResult - case (PLASTICITY_TITANMOD_ID) plasticityType - outputName = PLASTICITY_TITANMOD_label - thisNoutput => plastic_titanmod_Noutput - thisOutput => plastic_titanmod_output - thisSize => plastic_titanmod_sizePostResult case (PLASTICITY_NONLOCAL_ID) plasticityType outputName = PLASTICITY_NONLOCAL_label thisNoutput => plastic_nonlocal_Noutput @@ -396,11 +378,8 @@ function constitutive_homogenizedC(ipc,ip,el) use material, only: & phase_plasticity, & material_phase, & - PLASTICITY_TITANMOD_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID - use plastic_titanmod, only: & - plastic_titanmod_homogenizedC use plastic_dislotwin, only: & plastic_dislotwin_homogenizedC use lattice, only: & @@ -416,8 +395,6 @@ function constitutive_homogenizedC(ipc,ip,el) plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) case (PLASTICITY_DISLOTWIN_ID) plasticityType constitutive_homogenizedC = plastic_dislotwin_homogenizedC(ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - constitutive_homogenizedC = plastic_titanmod_homogenizedC (ipc,ip,el) case default plasticityType constitutive_homogenizedC = lattice_C66(1:6,1:6,material_phase (ipc,ip,el)) end select plasticityType @@ -438,19 +415,13 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) thermalMapping, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & - PLASTICITY_nonlocal_ID, & - PLASTICITY_phenoplus_ID - use plastic_titanmod, only: & - plastic_titanmod_microstructure + PLASTICITY_nonlocal_ID use plastic_nonlocal, only: & plastic_nonlocal_microstructure use plastic_dislotwin, only: & plastic_dislotwin_microstructure use plastic_disloucla, only: & plastic_disloucla_microstructure - use plastic_phenoplus, only: & - plastic_phenoplus_microstructure implicit none integer(pInt), intent(in) :: & @@ -474,12 +445,8 @@ subroutine constitutive_microstructure(orientations, Fe, Fp, ipc, ip, el) call plastic_dislotwin_microstructure(temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloucla_microstructure(temperature(ho)%p(tme),ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_microstructure (temperature(ho)%p(tme),ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_microstructure (Fe,Fp,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_microstructure(orientations,ipc,ip,el) end select plasticityType end subroutine constitutive_microstructure @@ -505,23 +472,17 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_PHENOPLUS_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & - PLASTICITY_TITANMOD_ID, & PLASTICITY_NONLOCAL_ID use plastic_isotropic, only: & plastic_isotropic_LpAndItsTangent use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_LpAndItsTangent - use plastic_phenoplus, only: & - plastic_phenoplus_LpAndItsTangent use plastic_dislotwin, only: & plastic_dislotwin_LpAndItsTangent use plastic_disloucla, only: & plastic_disloucla_LpAndItsTangent - use plastic_titanmod, only: & - plastic_titanmod_LpAndItsTangent use plastic_nonlocal, only: & plastic_nonlocal_LpAndItsTangent @@ -564,8 +525,6 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v call plastic_isotropic_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v,ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & temperature(ho)%p(tme),ip,el) @@ -575,9 +534,6 @@ subroutine constitutive_LpAndItsTangent(Lp, dLp_dTstar3333, dLp_dFi3333, Tstar_v case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloucla_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & temperature(ho)%p(tme), ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_LpAndItsTangent(Lp,dLp_dMstar,Mstar_v, & - temperature(ho)%p(tme), ipc,ip,el) end select plasticityType dLp_dTstar3333 = math_Plain99to3333(dLp_dMstar) @@ -888,10 +844,8 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID, & SOURCE_damage_isoDuctile_ID, & SOURCE_damage_anisoBrittle_ID, & @@ -901,14 +855,10 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra plastic_isotropic_dotState use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_dotState - use plastic_phenoplus, only: & - plastic_phenoplus_dotState use plastic_dislotwin, only: & plastic_dislotwin_dotState use plastic_disloucla, only: & plastic_disloucla_dotState - use plastic_titanmod, only: & - plastic_titanmod_dotState use plastic_nonlocal, only: & plastic_nonlocal_dotState use source_damage_isoDuctile, only: & @@ -954,17 +904,12 @@ subroutine constitutive_collectDotState(Tstar_v, FeArray, FpArray, subdt, subfra call plastic_isotropic_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType call plastic_phenopowerlaw_dotState(Tstar_v,ipc,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - call plastic_phenoplus_dotState (Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType call plastic_dislotwin_dotState (Tstar_v,temperature(ho)%p(tme), & ipc,ip,el) case (PLASTICITY_DISLOUCLA_ID) plasticityType call plastic_disloucla_dotState (Tstar_v,temperature(ho)%p(tme), & ipc,ip,el) - case (PLASTICITY_TITANMOD_ID) plasticityType - call plastic_titanmod_dotState (Tstar_v,temperature(ho)%p(tme), & - ipc,ip,el) case (PLASTICITY_NONLOCAL_ID) plasticityType call plastic_nonlocal_dotState (Tstar_v,FeArray,FpArray,temperature(ho)%p(tme), & subdt,subfracArray,ip,el) @@ -1097,10 +1042,8 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) PLASTICITY_NONE_ID, & PLASTICITY_ISOTROPIC_ID, & PLASTICITY_PHENOPOWERLAW_ID, & - PLASTICITY_PHENOPLUS_ID, & PLASTICITY_DISLOTWIN_ID, & PLASTICITY_DISLOUCLA_ID, & - PLASTICITY_TITANMOD_ID, & PLASTICITY_NONLOCAL_ID, & SOURCE_damage_isoBrittle_ID, & SOURCE_damage_isoDuctile_ID, & @@ -1110,14 +1053,10 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) plastic_isotropic_postResults use plastic_phenopowerlaw, only: & plastic_phenopowerlaw_postResults - use plastic_phenoplus, only: & - plastic_phenoplus_postResults use plastic_dislotwin, only: & plastic_dislotwin_postResults use plastic_disloucla, only: & plastic_disloucla_postResults - use plastic_titanmod, only: & - plastic_titanmod_postResults use plastic_nonlocal, only: & plastic_nonlocal_postResults use source_damage_isoBrittle, only: & @@ -1157,16 +1096,11 @@ function constitutive_postResults(Tstar_v, FeArray, ipc, ip, el) endPos = plasticState(material_phase(ipc,ip,el))%sizePostResults plasticityType: select case (phase_plasticity(material_phase(ipc,ip,el))) - case (PLASTICITY_TITANMOD_ID) plasticityType - constitutive_postResults(startPos:endPos) = plastic_titanmod_postResults(ipc,ip,el) case (PLASTICITY_ISOTROPIC_ID) plasticityType constitutive_postResults(startPos:endPos) = plastic_isotropic_postResults(Tstar_v,ipc,ip,el) case (PLASTICITY_PHENOPOWERLAW_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_phenopowerlaw_postResults(Tstar_v,ipc,ip,el) - case (PLASTICITY_PHENOPLUS_ID) plasticityType - constitutive_postResults(startPos:endPos) = & - plastic_phenoplus_postResults(Tstar_v,ipc,ip,el) case (PLASTICITY_DISLOTWIN_ID) plasticityType constitutive_postResults(startPos:endPos) = & plastic_dislotwin_postResults(Tstar_v,temperature(ho)%p(tme),ipc,ip,el) diff --git a/src/crystallite.f90 b/src/crystallite.f90 index d841794c5..d16084a29 100755 --- a/src/crystallite.f90 +++ b/src/crystallite.f90 @@ -554,7 +554,6 @@ subroutine crystallite_stressAndItsTangent(updateJaco) FEsolving_execIP use mesh, only: & mesh_element, & - mesh_NcpElems, & mesh_maxNips, & mesh_ipNeighborhood, & FE_NipNeighbors, & @@ -565,8 +564,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) plasticState, & sourceState, & phase_Nsources, & - phaseAt, phasememberAt, & - homogenization_maxNgrains + phaseAt, phasememberAt use constitutive, only: & constitutive_TandItsTangent, & constitutive_LpAndItsTangent, & @@ -794,7 +792,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (.not. crystallite_localPlasticity(1,neighboring_i,neighboring_e) & .and. .not. crystallite_converged(1,neighboring_i,neighboring_e)) then crystallite_neighborEnforcedCutback(i,e) = .true. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a12,i5,1x,i2,a,i5,1x,i2)') '<< CRYST >> ', neighboring_e,neighboring_i, & ' enforced cutback at ',e,i @@ -829,7 +827,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) if (.not. crystallite_localPlasticity(1,neighboring_i,neighboring_e) & .and. .not. crystallite_converged(1,neighboring_i,neighboring_e)) then crystallite_syncSubFrac(i,e) = .true. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt) & write(6,'(a12,i5,1x,i2,a,i5,1x,i2)') '<< CRYST >> ',neighboring_e,neighboring_i, & ' enforced time synchronization at ',e,i @@ -937,7 +935,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) crystallite_todo(c,i,e) = .true. endif !$OMP FLUSH(crystallite_todo) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. c == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & @@ -987,7 +985,7 @@ subroutine crystallite_stressAndItsTangent(updateJaco) ! cant restore dotState here, since not yet calculated in first cutback after initialization crystallite_todo(c,i,e) = crystallite_subStep(c,i,e) > subStepMinCryst ! still on track or already done (beyond repair) !$OMP FLUSH(crystallite_todo) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelBasic) /= 0_pInt) then if (crystallite_todo(c,i,e)) then write(6,'(a,f12.8,a,i8,1x,i2,1x,i3,/)') '<< CRYST >> cutback step in crystallite_stressAndItsTangent & @@ -1393,7 +1391,7 @@ subroutine crystallite_integrateStateRK4() * crystallite_subdt(g,i,e) * timeStepFraction(n) enddo -#ifndef _OPENMP +#ifdef DEBUG if (n == 4 & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & @@ -1784,7 +1782,7 @@ subroutine crystallite_integrateStateRKCK45() ! --- dot state and RK dot state--- -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt) & write(6,'(a,1x,i1)') '<< CRYST >> Runge--Kutta step',stage+1_pInt #endif @@ -1933,7 +1931,7 @@ subroutine crystallite_integrateStateRKCK45() sourceState(p)%p(mySource)%aTolState(1:mySizeSourceDotState)) enddo -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt& .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -2317,7 +2315,7 @@ subroutine crystallite_integrateStateAdaptiveEuler() !$OMP FLUSH(relPlasticStateResiduum) !$OMP FLUSH(relSourceStateResiduum) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g)& @@ -2513,7 +2511,7 @@ eIter = FEsolving_execElem(1:2) * crystallite_subdt(g,i,e) enddo -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -2962,7 +2960,7 @@ subroutine crystallite_integrateStateFPI() * (1.0_pReal - sourceStateDamper) enddo -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i .and. g == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3134,7 +3132,7 @@ logical function crystallite_stateJump(ipc,ip,el) sourceState(p)%p(mySource)%deltaState(1:mySizeSourceDeltaState,c) enddo -#ifndef _OPENMP +#ifdef DEBUG if (any(dNeq0(plasticState(p)%deltaState(1:mySizePlasticDeltaState,c))) & .and. iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & @@ -3309,7 +3307,7 @@ logical function crystallite_integrateStress(& !* be pessimistic crystallite_integrateStress = .false. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & @@ -3342,9 +3340,9 @@ logical function crystallite_integrateStress(& invFp_current = math_inv33(Fp_current) failedInversionFp: if (all(dEq0(invFp_current))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip g ',& + write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fp_current at el (elFE) ip ipc ',& el,'(',mesh_element(1,el),')',ip,ipc if (iand(debug_level(debug_crystallite), debug_levelExtensive) > 0_pInt) & write(6,'(/,a,/,3(12x,3(f12.7,1x)/))') '<< CRYST >> Fp_current',math_transpose33(Fp_current(1:3,1:3)) @@ -3358,7 +3356,7 @@ logical function crystallite_integrateStress(& invFi_current = math_inv33(Fi_current) failedInversionFi: if (all(dEq0(invFi_current))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on inversion of Fi_current at el (elFE) ip ipc ',& el,'(',mesh_element(1,el),')',ip,ipc @@ -3379,10 +3377,10 @@ logical function crystallite_integrateStress(& LiLoop: do NiterationStressLi = NiterationStressLi + 1_pInt IloopsExeced: if (NiterationStressLi > nStress) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached inelastic loop limit',nStress, & - ' at el (elFE) ip ipc ', el,mesh_element(1,el),ip,ipc + ' at el (elFE) ip ipc ', el,'(',mesh_element(1,el),')',ip,ipc #endif return endif IloopsExeced @@ -3400,7 +3398,7 @@ logical function crystallite_integrateStress(& LpLoop: do ! inner stress integration loop for consistency with Fi NiterationStressLp = NiterationStressLp + 1_pInt loopsExeced: if (NiterationStressLp > nStress) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i3,a,i8,1x,a,i8,a,1x,i2,1x,i3,/)') '<< CRYST >> integrateStress reached loop limit',nStress, & ' at el (elFE) ip ipc ', el,mesh_element(1,el),ip,ipc @@ -3433,7 +3431,7 @@ logical function crystallite_integrateStress(& !$OMP END CRITICAL (debugTimingLpTangent) endif -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3450,11 +3448,11 @@ logical function crystallite_integrateStress(& aTol_crystalliteStress) ! minimum lower cutoff residuumLp = Lpguess - Lp_constitutive - if (any(IEEE_is_NaN(residuumLp))) then ! NaN in residuum... -#ifndef _OPENMP + if (any(IEEE_is_NaN(residuumLp))) then ! NaN in residuum... +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) & write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3,a)') '<< CRYST >> integrateStress encountered NaN at el (elFE) ip ipc ', & - el,mesh_element(1,el),ip,ipc, & + el,'(',mesh_element(1,el),')',ip,ipc, & ' ; iteration ', NiterationStressLp,& ' >> returning..!' #endif @@ -3486,10 +3484,10 @@ logical function crystallite_integrateStress(& work = math_plain33to9(residuumLp) call dgesv(9,1,dRLp_dLp2,9,ipiv,work,9,ierr) ! solve dRLp/dLp * delta Lp = -res for delta Lp if (ierr /= 0_pInt) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el ip ipc ', & - el,mesh_element(1,el),ip,ipc + write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on dR/dLp inversion at el (elFE) ip ipc ', & + el,'(',mesh_element(1,el),')',ip,ipc if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g)& .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3527,7 +3525,7 @@ logical function crystallite_integrateStress(& call constitutive_LiAndItsTangent(Li_constitutive, dLi_dT3333, dLi_dFi3333, & Tstar_v, Fi_new, ipc, ip, el) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3575,10 +3573,10 @@ logical function crystallite_integrateStress(& work = math_plain33to9(residuumLi) call dgesv(9,1,dRLi_dLi,9,ipiv,work,9,ierr) ! solve dRLi/dLp * delta Li = -res for delta Li if (ierr /= 0_pInt) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on dR/dLi inversion at el ip ipc ', & - el,mesh_element(1,el),ip,ipc + write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3)') '<< CRYST >> integrateStress failed on dR/dLi inversion at el (elFE) ip ipc ', & + el,'(',mesh_element(1,el),')',ip,ipc if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g)& .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then @@ -3615,10 +3613,10 @@ logical function crystallite_integrateStress(& invFp_new = invFp_new / math_det33(invFp_new)**(1.0_pReal/3.0_pReal) ! regularize by det Fp_new = math_inv33(invFp_new) failedInversionInvFp: if (all(dEq0(Fp_new))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite), debug_levelBasic) /= 0_pInt) then - write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el ip ipc ',& - el,mesh_element(1,el),ip,ipc, ' ; iteration ', NiterationStressLp + write(6,'(a,i8,1x,a,i8,a,1x,i2,1x,i3,a,i3)') '<< CRYST >> integrateStress failed on invFp_new inversion at el (elFE) ip ipc ',& + el,'(',mesh_element(1,el),')',ip,ipc, ' ; iteration ', NiterationStressLp if (iand(debug_level(debug_crystallite), debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) & @@ -3649,7 +3647,7 @@ logical function crystallite_integrateStress(& !* set return flag to true crystallite_integrateStress = .true. -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_crystallite),debug_levelExtensive) /= 0_pInt & .and. ((el == debug_e .and. ip == debug_i .and. ipc == debug_g) & .or. .not. iand(debug_level(debug_crystallite), debug_levelSelective) /= 0_pInt)) then diff --git a/src/damage_local.f90 b/src/damage_local.f90 index a24f0b1a5..2f3014937 100644 --- a/src/damage_local.f90 +++ b/src/damage_local.f90 @@ -72,8 +72,6 @@ subroutine damage_local_init(fileUnit) damage, & damage_initialPhi, & material_partHomogenization - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -86,11 +84,9 @@ subroutine damage_local_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_local_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(damage_type == DAMAGE_local_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/damage_none.f90 b/src/damage_none.f90 index 746de340c..4750f5949 100644 --- a/src/damage_none.f90 +++ b/src/damage_none.f90 @@ -26,19 +26,15 @@ subroutine damage_none_init() use IO, only: & IO_timeStamp use material - use numerics, only: & - worldrank implicit none integer(pInt) :: & homog, & NofMyHomog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_none_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess initializeInstances: do homog = 1_pInt, material_Nhomogenization diff --git a/src/damage_nonlocal.f90 b/src/damage_nonlocal.f90 index fb960ed7f..cd6ba8a5b 100644 --- a/src/damage_nonlocal.f90 +++ b/src/damage_nonlocal.f90 @@ -77,8 +77,6 @@ subroutine damage_nonlocal_init(fileUnit) damage, & damage_initialPhi, & material_partHomogenization - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -91,11 +89,9 @@ subroutine damage_nonlocal_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- damage_'//DAMAGE_nonlocal_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(damage_type == DAMAGE_nonlocal_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/homogenization.f90 b/src/homogenization.f90 index 504f68e8c..5a30a72c8 100644 --- a/src/homogenization.f90 +++ b/src/homogenization.f90 @@ -542,6 +542,7 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) debug_level, & debug_homogenization, & debug_levelBasic, & + debug_levelExtensive, & debug_levelSelective, & debug_e, & debug_i, & @@ -638,8 +639,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) IpLooping1: do i = FEsolving_execIP(1,e),FEsolving_execIP(2,e) converged: if ( materialpoint_converged(i,e) ) then -#ifndef _OPENMP - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt & +#ifdef DEBUG + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i) & .or. .not. iand(debug_level(debug_homogenization),debug_levelSelective) /= 0_pInt)) then write(6,'(a,1x,f12.8,1x,a,1x,f12.8,1x,a,i8,1x,i2/)') '<< HOMOG >> winding forward from', & @@ -741,8 +742,8 @@ subroutine materialpoint_stressAndItsTangent(updateJaco,dt) materialpoint_subStep(i,e) = subStepSizeHomog * materialpoint_subStep(i,e) ! crystallite had severe trouble, so do a significant cutback !$OMP FLUSH(materialpoint_subStep) -#ifndef _OPENMP - if (iand(debug_level(debug_homogenization), debug_levelBasic) /= 0_pInt & +#ifdef DEBUG + if (iand(debug_level(debug_homogenization), debug_levelExtensive) /= 0_pInt & .and. ((e == debug_e .and. i == debug_i) & .or. .not. iand(debug_level(debug_homogenization), debug_levelSelective) /= 0_pInt)) then write(6,'(a,1x,f12.8,a,i8,1x,i2/)') & diff --git a/src/homogenization_RGC.f90 b/src/homogenization_RGC.f90 index 43c16a39d..84cb594db 100644 --- a/src/homogenization_RGC.f90 +++ b/src/homogenization_RGC.f90 @@ -100,8 +100,6 @@ subroutine homogenization_RGC_init(fileUnit) FE_geomtype use IO use material - use numerics, only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit !< file pointer to material configuration @@ -117,11 +115,9 @@ subroutine homogenization_RGC_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_RGC_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(homogenization_type == HOMOGENIZATION_RGC_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/homogenization_isostrain.f90 b/src/homogenization_isostrain.f90 index aeb77c275..055bfbb46 100644 --- a/src/homogenization_isostrain.f90 +++ b/src/homogenization_isostrain.f90 @@ -62,8 +62,6 @@ subroutine homogenization_isostrain_init(fileUnit) debug_levelBasic use IO use material - use numerics, only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -80,11 +78,9 @@ subroutine homogenization_isostrain_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_ISOSTRAIN_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = count(homogenization_type == HOMOGENIZATION_ISOSTRAIN_ID) if (maxNinstance == 0) return diff --git a/src/homogenization_none.f90 b/src/homogenization_none.f90 index 11bed7813..75d8bcd3a 100644 --- a/src/homogenization_none.f90 +++ b/src/homogenization_none.f90 @@ -29,21 +29,17 @@ subroutine homogenization_none_init() use IO, only: & IO_timeStamp use material - use numerics, only: & - worldrank implicit none integer(pInt) :: & homog, & NofMyHomog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- homogenization_'//HOMOGENIZATION_NONE_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess - initializeInstances: do homog = 1_pInt, material_Nhomogenization + initializeInstances: do homog = 1_pInt, material_Nhomogenization myhomog: if (homogenization_type(homog) == HOMOGENIZATION_none_ID) then NofMyHomog = count(material_homog == homog) diff --git a/src/hydrogenflux_cahnhilliard.f90 b/src/hydrogenflux_cahnhilliard.f90 index db08bf5d8..89479a9c9 100644 --- a/src/hydrogenflux_cahnhilliard.f90 +++ b/src/hydrogenflux_cahnhilliard.f90 @@ -84,8 +84,6 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) hydrogenflux_initialCh, & material_partHomogenization, & material_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -98,11 +96,9 @@ subroutine hydrogenflux_cahnhilliard_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_cahnhilliard_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(hydrogenflux_type == HYDROGENFLUX_cahnhilliard_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/hydrogenflux_isoconc.f90 b/src/hydrogenflux_isoconc.f90 index df5c01e68..bef2a8437 100644 --- a/src/hydrogenflux_isoconc.f90 +++ b/src/hydrogenflux_isoconc.f90 @@ -27,21 +27,17 @@ subroutine hydrogenflux_isoconc_init() use IO, only: & IO_timeStamp use material - use numerics, only: & - worldrank implicit none integer(pInt) :: & homog, & NofMyHomog - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- hydrogenflux_'//HYDROGENFLUX_isoconc_label//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess - initializeInstances: do homog = 1_pInt, material_Nhomogenization + initializeInstances: do homog = 1_pInt, material_Nhomogenization myhomog: if (hydrogenflux_type(homog) == HYDROGENFLUX_isoconc_ID) then NofMyHomog = count(material_homog == homog) diff --git a/src/kinematics_cleavage_opening.f90 b/src/kinematics_cleavage_opening.f90 index 146918f5c..fffa26165 100644 --- a/src/kinematics_cleavage_opening.f90 +++ b/src/kinematics_cleavage_opening.f90 @@ -81,8 +81,6 @@ subroutine kinematics_cleavage_opening_init(fileUnit) KINEMATICS_cleavage_opening_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank use lattice, only: & lattice_maxNcleavageFamily, & lattice_NcleavageSystem @@ -97,11 +95,9 @@ subroutine kinematics_cleavage_opening_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_cleavage_opening_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_cleavage_opening_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/kinematics_slipplane_opening.f90 b/src/kinematics_slipplane_opening.f90 index f32efa929..07b98aa23 100644 --- a/src/kinematics_slipplane_opening.f90 +++ b/src/kinematics_slipplane_opening.f90 @@ -81,8 +81,6 @@ subroutine kinematics_slipplane_opening_init(fileUnit) KINEMATICS_slipplane_opening_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank use lattice, only: & lattice_maxNslipFamily, & lattice_NslipSystem @@ -97,11 +95,9 @@ subroutine kinematics_slipplane_opening_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_slipplane_opening_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_slipplane_opening_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/kinematics_thermal_expansion.f90 b/src/kinematics_thermal_expansion.f90 index 30c267d34..e7cbca673 100644 --- a/src/kinematics_thermal_expansion.f90 +++ b/src/kinematics_thermal_expansion.f90 @@ -71,8 +71,6 @@ subroutine kinematics_thermal_expansion_init(fileUnit) KINEMATICS_thermal_expansion_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -83,11 +81,9 @@ subroutine kinematics_thermal_expansion_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_thermal_expansion_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_thermal_expansion_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/kinematics_vacancy_strain.f90 b/src/kinematics_vacancy_strain.f90 index 791c0e3c1..9558f506d 100644 --- a/src/kinematics_vacancy_strain.f90 +++ b/src/kinematics_vacancy_strain.f90 @@ -71,8 +71,6 @@ subroutine kinematics_vacancy_strain_init(fileUnit) KINEMATICS_vacancy_strain_ID, & material_Nphase, & MATERIAL_partPhase - use numerics,only: & - worldrank implicit none integer(pInt), intent(in) :: fileUnit @@ -83,11 +81,9 @@ subroutine kinematics_vacancy_strain_init(fileUnit) tag = '', & line = '' - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- kinematics_'//KINEMATICS_vacancy_strain_LABEL//' init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess maxNinstance = int(count(phase_kinematics == KINEMATICS_vacancy_strain_ID),pInt) if (maxNinstance == 0_pInt) return diff --git a/src/lattice.f90 b/src/lattice.f90 index 328d65380..9635643e8 100644 --- a/src/lattice.f90 +++ b/src/lattice.f90 @@ -96,19 +96,19 @@ module lattice real(pReal), dimension(3+3,LATTICE_fcc_Nslip), parameter, private :: & LATTICE_fcc_systemSlip = reshape(real([& - ! Slip direction Plane normal - 0, 1,-1, 1, 1, 1, & - -1, 0, 1, 1, 1, 1, & - 1,-1, 0, 1, 1, 1, & - 0,-1,-1, -1,-1, 1, & - 1, 0, 1, -1,-1, 1, & - -1, 1, 0, -1,-1, 1, & - 0,-1, 1, 1,-1,-1, & - -1, 0,-1, 1,-1,-1, & - 1, 1, 0, 1,-1,-1, & - 0, 1, 1, -1, 1,-1, & - 1, 0,-1, -1, 1,-1, & - -1,-1, 0, -1, 1,-1 & + ! Slip direction Plane normal ! SCHMID-BOAS notation + 0, 1,-1, 1, 1, 1, & ! B2 + -1, 0, 1, 1, 1, 1, & ! B4 + 1,-1, 0, 1, 1, 1, & ! B5 + 0,-1,-1, -1,-1, 1, & ! C1 + 1, 0, 1, -1,-1, 1, & ! C3 + -1, 1, 0, -1,-1, 1, & ! C5 + 0,-1, 1, 1,-1,-1, & ! A2 + -1, 0,-1, 1,-1,-1, & ! A3 + 1, 1, 0, 1,-1,-1, & ! A6 + 0, 1, 1, -1, 1,-1, & ! D1 + 1, 0,-1, -1, 1,-1, & ! D4 + -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 real(pReal), dimension(3+3,LATTICE_fcc_Ntwin), parameter, private :: & diff --git a/src/material.f90 b/src/material.f90 index 587958f16..aad71d49c 100644 --- a/src/material.f90 +++ b/src/material.f90 @@ -25,10 +25,8 @@ module material PLASTICITY_none_label = 'none', & PLASTICITY_isotropic_label = 'isotropic', & PLASTICITY_phenopowerlaw_label = 'phenopowerlaw', & - PLASTICITY_phenoplus_label = 'phenoplus', & PLASTICITY_dislotwin_label = 'dislotwin', & PLASTICITY_disloucla_label = 'disloucla', & - PLASTICITY_titanmod_label = 'titanmod', & PLASTICITY_nonlocal_label = 'nonlocal', & SOURCE_thermal_dissipation_label = 'thermal_dissipation', & SOURCE_thermal_externalheat_label = 'thermal_externalheat', & @@ -74,10 +72,8 @@ module material PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID end enum @@ -312,10 +308,8 @@ module material PLASTICITY_none_ID, & PLASTICITY_isotropic_ID, & PLASTICITY_phenopowerlaw_ID, & - PLASTICITY_phenoplus_ID, & PLASTICITY_dislotwin_ID, & PLASTICITY_disloucla_ID, & - PLASTICITY_titanmod_ID, & PLASTICITY_nonlocal_ID, & SOURCE_thermal_dissipation_ID, & SOURCE_thermal_externalheat_ID, & @@ -989,14 +983,10 @@ subroutine material_parsePhase(fileUnit,myPart) phase_plasticity(section) = PLASTICITY_ISOTROPIC_ID case (PLASTICITY_PHENOPOWERLAW_label) phase_plasticity(section) = PLASTICITY_PHENOPOWERLAW_ID - case (PLASTICITY_PHENOPLUS_label) - phase_plasticity(section) = PLASTICITY_PHENOPLUS_ID case (PLASTICITY_DISLOTWIN_label) phase_plasticity(section) = PLASTICITY_DISLOTWIN_ID case (PLASTICITY_DISLOUCLA_label) phase_plasticity(section) = PLASTICITY_DISLOUCLA_ID - case (PLASTICITY_TITANMOD_label) - phase_plasticity(section) = PLASTICITY_TITANMOD_ID case (PLASTICITY_NONLOCAL_label) phase_plasticity(section) = PLASTICITY_NONLOCAL_ID case default diff --git a/src/math.f90 b/src/math.f90 index 3a9dafd0b..2d3b42dc0 100755 --- a/src/math.f90 +++ b/src/math.f90 @@ -178,7 +178,7 @@ subroutine math_init compiler_version, & compiler_options #endif - use numerics, only: fixedSeed + use numerics, only: randomSeed use IO, only: IO_timeStamp implicit none @@ -195,8 +195,8 @@ subroutine math_init call random_seed(size=randSize) if (allocated(randInit)) deallocate(randInit) allocate(randInit(randSize)) - if (fixedSeed > 0_pInt) then - randInit(1:randSize) = int(fixedSeed) ! fixedSeed is of type pInt, randInit not + if (randomSeed > 0_pInt) then + randInit(1:randSize) = int(randomSeed) ! randomSeed is of type pInt, randInit not call random_seed(put=randInit) else call random_seed() @@ -1440,35 +1440,37 @@ end function math_RtoQ !-------------------------------------------------------------------------------------------------- -!> @brief rotation matrix from Euler angles (in radians) -!> @details rotation matrix is meant to represent a PASSIVE rotation, -!> @details composed of INTRINSIC rotations around the axes of the -!> @details rotating reference frame -!> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) +!> @brief rotation matrix from Bunge-Euler (3-1-3) angles (in radians) +!> @details rotation matrix is meant to represent a PASSIVE rotation, composed of INTRINSIC +!> @details rotations around the axes of the details rotating reference frame. +!> @details similar to eu2om from "D Rowenhorst et al. Consistent representations of and conversions +!> @details between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)", but R is transposed !-------------------------------------------------------------------------------------------------- pure function math_EulerToR(Euler) implicit none real(pReal), dimension(3), intent(in) :: Euler real(pReal), dimension(3,3) :: math_EulerToR - real(pReal) c1, c, c2, s1, s, s2 + real(pReal) :: c1, C, c2, s1, S, s2 - C1 = cos(Euler(1)) + c1 = cos(Euler(1)) C = cos(Euler(2)) - C2 = cos(Euler(3)) - S1 = sin(Euler(1)) + c2 = cos(Euler(3)) + s1 = sin(Euler(1)) S = sin(Euler(2)) - S2 = sin(Euler(3)) + s2 = sin(Euler(3)) - math_EulerToR(1,1)=C1*C2-S1*S2*C - math_EulerToR(1,2)=-C1*S2-S1*C2*C - math_EulerToR(1,3)=S1*S - math_EulerToR(2,1)=S1*C2+C1*S2*C - math_EulerToR(2,2)=-S1*S2+C1*C2*C - math_EulerToR(2,3)=-C1*S - math_EulerToR(3,1)=S2*S - math_EulerToR(3,2)=C2*S - math_EulerToR(3,3)=C + math_EulerToR(1,1) = c1*c2 -s1*C*s2 + math_EulerToR(1,2) = -c1*s2 -s1*C*c2 + math_EulerToR(1,3) = s1*S + + math_EulerToR(2,1) = s1*c2 +c1*C*s2 + math_EulerToR(2,2) = -s1*s2 +c1*C*c2 + math_EulerToR(2,3) = -c1*S + + math_EulerToR(3,1) = S*s2 + math_EulerToR(3,2) = S*c2 + math_EulerToR(3,3) = C math_EulerToR = transpose(math_EulerToR) ! convert to passive rotation @@ -1476,29 +1478,29 @@ end function math_EulerToR !-------------------------------------------------------------------------------------------------- -!> @brief quaternion (w+ix+jy+kz) from 3-1-3 Euler angles (in radians) -!> @details quaternion is meant to represent a PASSIVE rotation, -!> @details composed of INTRINSIC rotations around the axes of the -!> @details rotating reference frame -!> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) +!> @brief quaternion (w+ix+jy+kz) from Bunge-Euler (3-1-3) angles (in radians) +!> @details rotation matrix is meant to represent a PASSIVE rotation, composed of INTRINSIC +!> @details rotations around the axes of the details rotating reference frame. +!> @details similar to eu2qu from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)", but +!> @details Q is conjucated and Q is not reversed for Q(0) < 0. !-------------------------------------------------------------------------------------------------- pure function math_EulerToQ(eulerangles) implicit none real(pReal), dimension(3), intent(in) :: eulerangles real(pReal), dimension(4) :: math_EulerToQ - real(pReal), dimension(3) :: halfangles - real(pReal) :: c, s + real(pReal) :: c, s, sigma, delta - halfangles = 0.5_pReal * eulerangles - - c = cos(halfangles(2)) - s = sin(halfangles(2)) - - math_EulerToQ= [cos(halfangles(1)+halfangles(3)) * c, & - cos(halfangles(1)-halfangles(3)) * s, & - sin(halfangles(1)-halfangles(3)) * s, & - sin(halfangles(1)+halfangles(3)) * c ] + c = cos(0.5_pReal * eulerangles(2)) + s = sin(0.5_pReal * eulerangles(2)) + sigma = 0.5_pReal * (eulerangles(1)+eulerangles(3)) + delta = 0.5_pReal * (eulerangles(1)-eulerangles(3)) + + math_EulerToQ= [c * cos(sigma), & + s * cos(delta), & + s * sin(delta), & + c * sin(sigma) ] math_EulerToQ = math_qConj(math_EulerToQ) ! convert to passive rotation end function math_EulerToQ @@ -1509,6 +1511,8 @@ end function math_EulerToQ !> @details rotation matrix is meant to represent a ACTIVE rotation !> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) !> @details formula for active rotation taken from http://mathworld.wolfram.com/RodriguesRotationFormula.html +!> @details equivalent to eu2om (P=-1) from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)" !-------------------------------------------------------------------------------------------------- pure function math_axisAngleToR(axis,omega) @@ -1516,31 +1520,31 @@ pure function math_axisAngleToR(axis,omega) real(pReal), dimension(3,3) :: math_axisAngleToR real(pReal), dimension(3), intent(in) :: axis real(pReal), intent(in) :: omega - real(pReal), dimension(3) :: axisNrm + real(pReal), dimension(3) :: n real(pReal) :: norm,s,c,c1 norm = norm2(axis) - if (norm > 1.0e-8_pReal) then ! non-zero rotation - axisNrm = axis/norm ! normalize axis to be sure + wellDefined: if (norm > 1.0e-8_pReal) then + n = axis/norm ! normalize axis to be sure s = sin(omega) c = cos(omega) c1 = 1.0_pReal - c - math_axisAngleToR(1,1) = c + c1*axisNrm(1)**2.0_pReal - math_axisAngleToR(1,2) = -s*axisNrm(3) + c1*axisNrm(1)*axisNrm(2) - math_axisAngleToR(1,3) = s*axisNrm(2) + c1*axisNrm(1)*axisNrm(3) + math_axisAngleToR(1,1) = c + c1*n(1)**2.0_pReal + math_axisAngleToR(1,2) = c1*n(1)*n(2) - s*n(3) + math_axisAngleToR(1,3) = c1*n(1)*n(3) + s*n(2) - math_axisAngleToR(2,1) = s*axisNrm(3) + c1*axisNrm(2)*axisNrm(1) - math_axisAngleToR(2,2) = c + c1*axisNrm(2)**2.0_pReal - math_axisAngleToR(2,3) = -s*axisNrm(1) + c1*axisNrm(2)*axisNrm(3) + math_axisAngleToR(2,1) = c1*n(1)*n(2) + s*n(3) + math_axisAngleToR(2,2) = c + c1*n(2)**2.0_pReal + math_axisAngleToR(2,3) = c1*n(2)*n(3) - s*n(1) - math_axisAngleToR(3,1) = -s*axisNrm(2) + c1*axisNrm(3)*axisNrm(1) - math_axisAngleToR(3,2) = s*axisNrm(1) + c1*axisNrm(3)*axisNrm(2) - math_axisAngleToR(3,3) = c + c1*axisNrm(3)**2.0_pReal - else + math_axisAngleToR(3,1) = c1*n(1)*n(3) - s*n(2) + math_axisAngleToR(3,2) = c1*n(2)*n(3) + s*n(1) + math_axisAngleToR(3,3) = c + c1*n(3)**2.0_pReal + else wellDefined math_axisAngleToR = math_I3 - endif + endif wellDefined end function math_axisAngleToR @@ -1549,6 +1553,8 @@ end function math_axisAngleToR !> @brief rotation matrix from axis and angle (in radians) !> @details rotation matrix is meant to represent a PASSIVE rotation !> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) +!> @details eq-uivalent to eu2qu (P=+1) from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)" !-------------------------------------------------------------------------------------------------- pure function math_EulerAxisAngleToR(axis,omega) @@ -1585,8 +1591,10 @@ end function math_EulerAxisAngleToQ !> @brief quaternion (w+ix+jy+kz) from axis and angle (in radians) !> @details quaternion is meant to represent an ACTIVE rotation !> @details (see http://en.wikipedia.org/wiki/Euler_angles for definitions) -!> @details formula for active rotation taken from +!> @details formula for active rotation taken from !> @details http://en.wikipedia.org/wiki/Rotation_representation_%28mathematics%29#Rodrigues_parameters +!> @details equivalent to eu2qu (P=+1) from "D Rowenhorst et al. Consistent representations of and +!> @details conversions between 3D rotations, Model. Simul. Mater. Sci. Eng. 23-8 (2015)" !-------------------------------------------------------------------------------------------------- pure function math_axisAngleToQ(axis,omega) @@ -1597,13 +1605,13 @@ pure function math_axisAngleToQ(axis,omega) real(pReal), dimension(3) :: axisNrm real(pReal) :: norm - norm = sqrt(math_mul3x3(axis,axis)) - rotation: if (norm > 1.0e-8_pReal) then + norm = norm2(axis) + wellDefined: if (norm > 1.0e-8_pReal) then axisNrm = axis/norm ! normalize axis to be sure math_axisAngleToQ = [cos(0.5_pReal*omega), sin(0.5_pReal*omega) * axisNrm(1:3)] - else rotation + else wellDefined math_axisAngleToQ = [1.0_pReal,0.0_pReal,0.0_pReal,0.0_pReal] - endif rotation + endif wellDefined end function math_axisAngleToQ diff --git a/src/mesh.f90 b/src/mesh.f90 index 87160f2c7..d7d0f8c06 100644 --- a/src/mesh.f90 +++ b/src/mesh.f90 @@ -4,7 +4,7 @@ !> @author Christoph Koords, Max-Planck-Institut für Eisenforschung GmbH !> @author Martin Diehl, Max-Planck-Institut für Eisenforschung GmbH !> @author Krishna Komerla, Max-Planck-Institut für Eisenforschung GmbH -!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver +!> @brief Sets up the mesh for the solvers MSC.Marc, Abaqus and the spectral solver !-------------------------------------------------------------------------------------------------- module mesh use, intrinsic :: iso_c_binding @@ -45,7 +45,7 @@ module mesh mesh_element, & !< FEid, type(internal representation), material, texture, node indices as CP IDs mesh_sharedElem, & !< entryCount and list of elements containing node mesh_nodeTwins !< node twins are surface nodes that lie exactly on opposite sides of the mesh (surfaces nodes with equal coordinate values in two dimensions) - + integer(pInt), dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipNeighborhood !< 6 or less neighboring IPs as [element_num, IP_index, neighbor_index that points to me] @@ -55,31 +55,34 @@ module mesh real(pReal), dimension(:,:), allocatable, public :: & mesh_node, & !< node x,y,z coordinates (after deformation! ONLY FOR MARC!!!) mesh_cellnode !< cell 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, protected :: & mesh_ipArea !< area of interface to neighboring IP (initially!) - + real(pReal), dimension(:,:,:), allocatable, public :: & mesh_ipCoordinates !< IP x,y,z coordinates (after deformation!) - real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & + real(pReal),dimension(:,:,:,:), allocatable, public, protected :: & mesh_ipAreaNormal !< area normal of interface to neighboring IP (initially!) - + logical, dimension(3), public, protected :: mesh_periodicSurface !< flag indicating periodic outer surfaces (used for fluxes) #ifdef Marc4DAMASK - integer(pInt), private :: & + integer(pInt), private :: & + MarcVersion, & !< Version of input file format (Marc only) hypoelasticTableStyle, & !< Table style (Marc only) initialcondTableStyle !< Table style (Marc only) + integer(pInt), dimension(:), allocatable, private :: & + Marc_matNumber !< array of material numbers for hypoelastic material (Marc only) #endif - + integer(pInt), dimension(2), private :: & mesh_maxValStateVar = 0_pInt - + #ifndef Spectral character(len=64), dimension(:), allocatable, private :: & mesh_nameElemSet, & !< names of elementSet @@ -104,13 +107,13 @@ module mesh FE_ipNeighbor, & !< +x,-x,+y,-y,+z,-z list of intra-element IPs and(negative) neighbor faces per own IP in a specific type of element FE_cell, & !< list of intra-element cell node IDs that constitute the cells in a specific type of element geometry FE_cellface !< list of intra-cell cell node IDs that constitute the cell faces of a specific type of cell - + real(pReal), dimension(:,:,:), allocatable, private :: & FE_cellnodeParentnodeWeights !< list of node weights for the generation of cell nodes - + integer(pInt), dimension(:,:,:,:), allocatable, private :: & FE_subNodeOnIPFace - + #ifdef Abaqus logical, private :: noPart !< for cases where the ABAQUS input file does not use part/assembly information #endif @@ -137,7 +140,7 @@ module mesh FE_maxNcellnodesPerCell = 8_pInt, & FE_maxNcellfaces = 6_pInt, & FE_maxNcellnodesPerCellface = 4_pInt - + integer(pInt), dimension(FE_Nelemtypes), parameter, public :: FE_geomtype = & !< geometry type of particular element type int([ & 1, & ! element 6 (2D 3node 1ip) @@ -241,7 +244,7 @@ module mesh 4,4,4,4,4,4, & ! element 117 (3D 8node 1ip) 4,4,4,4,4,4, & ! element 7 (3D 8node 8ip) 4,4,4,4,4,4 & ! element 21 (3D 20node 27ip) - ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) + ],pInt),[FE_maxNipNeighbors,FE_Ngeomtypes]) integer(pInt), dimension(FE_maxNmatchingNodesPerFace,FE_maxNfaces,FE_Ngeomtypes), & parameter, private :: FE_face = & !< List of node indices on each face of a specific type of element geometry @@ -375,7 +378,7 @@ module mesh 4 & ! element 21 (3D 20node 27ip) ],pInt) - + integer(pInt), dimension(FE_Nelemtypes), parameter, private :: MESH_VTKELEMTYPE = & int([ & 5, & ! element 6 (2D 3node 1ip) @@ -428,13 +431,15 @@ module mesh mesh_spectral_build_elements, & mesh_spectral_build_ipNeighborhood, & #elif defined Marc4DAMASK + mesh_marc_get_fileFormat, & mesh_marc_get_tableStyles, & + mesh_marc_get_matNumber, & mesh_marc_count_nodesAndElements, & mesh_marc_count_elementSets, & mesh_marc_map_elementSets, & mesh_marc_count_cpElements, & mesh_marc_map_Elements, & - mesh_marc_map_nodes, & + mesh_marc_map_nodes, & mesh_marc_build_nodes, & mesh_marc_count_cpSizes, & mesh_marc_build_elements, & @@ -450,7 +455,7 @@ module mesh mesh_abaqus_build_nodes, & mesh_abaqus_count_cpSizes, & mesh_abaqus_build_elements, & -#endif +#endif #ifndef Spectral mesh_build_nodeTwins, & mesh_build_sharedElems, & @@ -508,7 +513,7 @@ subroutine mesh_init(ip,el) #endif FEsolving_execIP, & calcMode - + implicit none #ifdef Spectral integer(C_INTPTR_T) :: devNull, local_K, local_K_offset @@ -518,7 +523,9 @@ subroutine mesh_init(ip,el) integer(pInt), intent(in) :: el, ip integer(pInt) :: j logical :: myDebug - + + external :: MPI_comm_size + write(6,'(/,a)') ' <<<+- mesh init -+>>>' write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" @@ -544,7 +551,7 @@ subroutine mesh_init(ip,el) if (allocated(FE_subNodeOnIPFace)) deallocate(FE_subNodeOnIPFace) call mesh_build_FEdata ! get properties of the different types of elements mesh_unitlength = numerics_unitlength ! set physical extent of a length unit in mesh - + myDebug = (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) #ifdef Spectral @@ -577,8 +584,14 @@ subroutine mesh_init(ip,el) #elif defined Marc4DAMASK call IO_open_inputFile(FILEUNIT,modelName) ! parse info from input file... if (myDebug) write(6,'(a)') ' Opened input file'; flush(6) + call mesh_marc_get_fileFormat(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got input file format'; flush(6) call mesh_marc_get_tableStyles(FILEUNIT) if (myDebug) write(6,'(a)') ' Got table styles'; flush(6) + if (MarcVersion > 12) then + call mesh_marc_get_matNumber(FILEUNIT) + if (myDebug) write(6,'(a)') ' Got hypoleastic material number'; flush(6) + endif call mesh_marc_count_nodesAndElements(FILEUNIT) if (myDebug) write(6,'(a)') ' Counted nodes/elements'; flush(6) call mesh_marc_count_elementSets(FILEUNIT) @@ -660,12 +673,12 @@ subroutine mesh_init(ip,el) 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) @@ -686,10 +699,10 @@ integer(pInt) function mesh_FEasCP(what,myID) implicit none character(len=*), intent(in) :: what integer(pInt), intent(in) :: myID - + integer(pInt), dimension(:,:), pointer :: lookupMap integer(pInt) :: lower,upper,center - + mesh_FEasCP = 0_pInt select case(IO_lc(what(1:4))) case('elem') @@ -699,10 +712,10 @@ integer(pInt) function mesh_FEasCP(what,myID) case default return endselect - + lower = 1_pInt upper = int(size(lookupMap,2_pInt),pInt) - + if (lookupMap(1_pInt,lower) == myID) then ! check at bounds QUESTION is it valid to extend bounds by 1 and just do binary search w/o init check at bounds? mesh_FEasCP = lookupMap(2_pInt,lower) return @@ -721,19 +734,19 @@ integer(pInt) function mesh_FEasCP(what,myID) exit endif enddo binarySearch - + end function mesh_FEasCP !-------------------------------------------------------------------------------------------------- !> @brief Split CP elements into cells. -!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). -!> Cell nodes that are also matching nodes are unique in the list of cell nodes, +!> @details Build a mapping between cells and the corresponding cell nodes ('mesh_cell'). +!> Cell nodes that are also matching nodes are unique in the list of cell nodes, !> all others (currently) might be stored more than once. !> Also allocates the 'mesh_node' array. !-------------------------------------------------------------------------------------------------- subroutine mesh_build_cellconnectivity - + implicit none integer(pInt), dimension(:), allocatable :: & matchingNode2cellnode @@ -742,14 +755,14 @@ subroutine mesh_build_cellconnectivity integer(pInt), dimension(mesh_maxNcellnodes) :: & localCellnode2globalCellnode integer(pInt) :: & - e,t,g,c,n,i, & + e,t,g,c,n,i, & matchingNodeID, & localCellnodeID - + allocate(mesh_cell(FE_maxNcellnodesPerCell,mesh_maxNips,mesh_NcpElems), source=0_pInt) allocate(matchingNode2cellnode(mesh_Nnodes), source=0_pInt) allocate(cellnodeParent(2_pInt,mesh_maxNcellnodes*mesh_NcpElems), source=0_pInt) - + !-------------------------------------------------------------------------------------------------- ! Count cell nodes (including duplicates) and generate cell connectivity list mesh_Ncellnodes = 0_pInt @@ -794,28 +807,28 @@ subroutine mesh_build_cellconnectivity deallocate(matchingNode2cellnode) deallocate(cellnodeParent) - + end subroutine mesh_build_cellconnectivity !-------------------------------------------------------------------------------------------------- !> @brief Calculate position of cellnodes from the given position of nodes -!> Build list of cellnodes' coordinates. +!> Build list of cellnodes' coordinates. !> Cellnode coordinates are calculated from a weighted sum of node coordinates. !-------------------------------------------------------------------------------------------------- function mesh_build_cellnodes(nodes,Ncellnodes) - + implicit none integer(pInt), intent(in) :: Ncellnodes !< requested number of cellnodes real(pReal), dimension(3,mesh_Nnodes), intent(in) :: nodes real(pReal), dimension(3,Ncellnodes) :: mesh_build_cellnodes integer(pInt) :: & - e,t,n,m, & + e,t,n,m, & localCellnodeID real(pReal), dimension(3) :: & myCoords - + mesh_build_cellnodes = 0.0_pReal !$OMP PARALLEL DO PRIVATE(e,localCellnodeID,t,myCoords) do n = 1_pInt,Ncellnodes ! loop over cell nodes @@ -840,23 +853,23 @@ end function mesh_build_cellnodes !> 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 +!> calculated as an average of four tetrahedals with three corners on the cell face !> and one corner at the central ip. !-------------------------------------------------------------------------------------------------- subroutine mesh_build_ipVolumes use math, only: & math_volTetrahedron, & math_areaTriangle - + implicit none integer(pInt) :: e,t,g,c,i,m,f,n real(pReal), dimension(FE_maxNcellnodesPerCellface,FE_maxNcellfaces) :: subvolume if (.not. allocated(mesh_ipVolume)) then allocate(mesh_ipVolume(mesh_maxNips,mesh_NcpElems)) - mesh_ipVolume = 0.0_pReal + mesh_ipVolume = 0.0_pReal endif - + !$OMP PARALLEL DO PRIVATE(t,g,c,m,subvolume) do e = 1_pInt,mesh_NcpElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type @@ -869,7 +882,7 @@ subroutine mesh_build_ipVolumes mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & mesh_cellnode(1:3,mesh_cell(2,i,e)), & mesh_cellnode(1:3,mesh_cell(3,i,e))) - + case (2_pInt) ! 2D 4node forall (i = 1_pInt:FE_Nips(g)) & ! loop over ips=cells in this element mesh_ipVolume(i,e) = math_areaTriangle(mesh_cellnode(1:3,mesh_cell(1,i,e)), & ! here we assume a planar shape, so division in two triangles suffices @@ -914,19 +927,19 @@ end subroutine mesh_build_ipVolumes ! 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. +! AS THE IP IS NOT (ALWAYS) LOCATED IN THE CENTER OF THE IP VOLUME. +! HAS TO BE CHANGED IN A LATER VERSION. ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! !-------------------------------------------------------------------------------------------------- subroutine mesh_build_ipCoordinates - + implicit none integer(pInt) :: e,t,g,c,i,n real(pReal), dimension(3) :: myCoords if (.not. allocated(mesh_ipCoordinates)) & allocate(mesh_ipCoordinates(3,mesh_maxNips,mesh_NcpElems),source=0.0_pReal) - + !$OMP PARALLEL DO PRIVATE(t,g,c,myCoords) do e = 1_pInt,mesh_NcpElems ! loop over cpElems t = mesh_element(2_pInt,e) ! get element type @@ -949,13 +962,13 @@ end subroutine mesh_build_ipCoordinates !> @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 integer(pInt) :: t,g,c,n - + t = mesh_element(2_pInt,el) ! get element type g = FE_geomtype(t) ! get geometry type c = FE_celltype(g) ! get cell type @@ -970,7 +983,7 @@ pure function mesh_cellCenterCoordinates(ip,el) #ifdef Spectral !-------------------------------------------------------------------------------------------------- -!> @brief Reads grid information from geometry file. If fileUnit is given, +!> @brief Reads grid information from geometry file. If fileUnit is given, !! assumes an opened file, otherwise tries to open the one specified in geometryFile !-------------------------------------------------------------------------------------------------- function mesh_spectral_getGrid(fileUnit) @@ -985,7 +998,7 @@ function mesh_spectral_getGrid(fileUnit) IO_error use DAMASK_interface, only: & geometryFile - + implicit none integer(pInt), dimension(3) :: mesh_spectral_getGrid integer(pInt), intent(in), optional :: fileUnit @@ -996,7 +1009,7 @@ function mesh_spectral_getGrid(fileUnit) keyword integer(pInt) :: i, j, myFileUnit logical :: gotGrid = .false. - + mesh_spectral_getGrid = -1_pInt if(.not. present(fileUnit)) then myFileUnit = 289_pInt @@ -1004,7 +1017,7 @@ function mesh_spectral_getGrid(fileUnit) else myFileUnit = fileUnit endif - + call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line @@ -1018,7 +1031,7 @@ function mesh_spectral_getGrid(fileUnit) rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt,.true.)) ) case ('grid') gotGrid = .true. @@ -1034,9 +1047,9 @@ function mesh_spectral_getGrid(fileUnit) enddo end select enddo - + if(.not. present(fileUnit)) close(myFileUnit) - + if (.not. gotGrid) & call IO_error(error_ID = 845_pInt, ext_msg='grid') if(any(mesh_spectral_getGrid < 1_pInt)) & @@ -1046,7 +1059,7 @@ end function mesh_spectral_getGrid !-------------------------------------------------------------------------------------------------- -!> @brief Reads size information from geometry file. If fileUnit is given, +!> @brief Reads size information from geometry file. If fileUnit is given, !! assumes an opened file, otherwise tries to open the one specified in geometryFile !-------------------------------------------------------------------------------------------------- function mesh_spectral_getSize(fileUnit) @@ -1061,7 +1074,7 @@ function mesh_spectral_getSize(fileUnit) IO_error use DAMASK_interface, only: & geometryFile - + implicit none real(pReal), dimension(3) :: mesh_spectral_getSize integer(pInt), intent(in), optional :: fileUnit @@ -1069,9 +1082,9 @@ function mesh_spectral_getSize(fileUnit) integer(pInt) :: headerLength = 0_pInt character(len=1024) :: line, & keyword - integer(pInt) :: i, j, myFileUnit + integer(pInt) :: i, j, myFileUnit logical :: gotSize = .false. - + mesh_spectral_getSize = -1.0_pReal if(.not. present(fileUnit)) then myFileUnit = 289_pInt @@ -1079,7 +1092,7 @@ function mesh_spectral_getSize(fileUnit) else myFileUnit = fileUnit endif - + call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line @@ -1093,7 +1106,7 @@ function mesh_spectral_getSize(fileUnit) rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) case ('size') gotSize = .true. @@ -1109,7 +1122,7 @@ function mesh_spectral_getSize(fileUnit) enddo end select enddo - + if(.not. present(fileUnit)) close(myFileUnit) if (.not. gotSize) & @@ -1121,7 +1134,7 @@ end function mesh_spectral_getSize !-------------------------------------------------------------------------------------------------- -!> @brief Reads homogenization information from geometry file. If fileUnit is given, +!> @brief Reads homogenization information from geometry file. If fileUnit is given, !! assumes an opened file, otherwise tries to open the one specified in geometryFile !-------------------------------------------------------------------------------------------------- integer(pInt) function mesh_spectral_getHomogenization(fileUnit) @@ -1135,7 +1148,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) IO_error use DAMASK_interface, only: & geometryFile - + implicit none integer(pInt), intent(in), optional :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos @@ -1144,7 +1157,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) keyword integer(pInt) :: i, myFileUnit logical :: gotHomogenization = .false. - + mesh_spectral_getHomogenization = -1_pInt if(.not. present(fileUnit)) then myFileUnit = 289_pInt @@ -1152,7 +1165,7 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) else myFileUnit = fileUnit endif - + call IO_checkAndRewind(myFileUnit) read(myFileUnit,'(a1024)') line @@ -1166,21 +1179,21 @@ integer(pInt) function mesh_spectral_getHomogenization(fileUnit) rewind(myFileUnit) do i = 1_pInt, headerLength read(myFileUnit,'(a1024)') line - chunkPos = IO_stringPos(line) + chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1,.true.)) ) case ('homogenization') gotHomogenization = .true. mesh_spectral_getHomogenization = IO_intValue(line,chunkPos,2_pInt) end select enddo - + if(.not. present(fileUnit)) close(myFileUnit) - + if (.not. gotHomogenization ) & call IO_error(error_ID = 845_pInt, ext_msg='homogenization') if (mesh_spectral_getHomogenization<1_pInt) & call IO_error(error_ID = 842_pInt, ext_msg='mesh_spectral_getHomogenization') - + end function mesh_spectral_getHomogenization @@ -1195,7 +1208,7 @@ subroutine mesh_spectral_count() mesh_Nelems = product(grid(1:2))*grid3 mesh_NcpElems= mesh_Nelems mesh_Nnodes = product(grid(1:2) + 1_pInt)*(grid3 + 1_pInt) - + mesh_NcpElemsGlobal = product(grid) end subroutine mesh_spectral_count @@ -1221,14 +1234,14 @@ 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', +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- subroutine mesh_spectral_count_cpSizes - + implicit none integer(pInt) :: t,g,c - + t = FE_mapElemtype('C3D8R') ! fake 3D hexahedral 8 node 1 IP element g = FE_geomtype(t) c = FE_celltype(g) @@ -1252,7 +1265,7 @@ subroutine mesh_spectral_build_nodes() allocate (mesh_node0 (3,mesh_Nnodes), source = 0.0_pReal) allocate (mesh_node (3,mesh_Nnodes), source = 0.0_pReal) - + forall (n = 0_pInt:mesh_Nnodes-1_pInt) mesh_node0(1,n+1_pInt) = mesh_unitlength * & geomSize(1)*real(mod(n,(grid(1)+1_pInt) ),pReal) & @@ -1263,8 +1276,8 @@ subroutine mesh_spectral_build_nodes() mesh_node0(3,n+1_pInt) = mesh_unitlength * & size3*real(mod(n/(grid(1)+1_pInt)/(grid(2)+1_pInt),(grid3+1_pInt)),pReal) & / real(grid3,pReal) + & - size3offset - end forall + size3offset + end forall mesh_node = mesh_node0 @@ -1322,7 +1335,7 @@ subroutine mesh_spectral_build_elements(fileUnit) else call IO_error(error_ID=841_pInt, ext_msg='mesh_spectral_build_elements') endif - + !-------------------------------------------------------------------------------------------------- ! get maximum microstructure index call IO_checkAndRewind(fileUnit) @@ -1347,7 +1360,7 @@ subroutine mesh_spectral_build_elements(fileUnit) do i=1_pInt,headerLength read(fileUnit,'(a65536)') line enddo - + e = 0_pInt do while (e < mesh_NcpElemsGlobal .and. microstructures(1) > 0_pInt) ! fill expected number of elements, stop at end of data (or blank line!) microstructures = IO_continuousIntValues(fileUnit,maxIntCount,dummyName,dummySet,0_pInt) ! get affected elements @@ -1357,7 +1370,7 @@ subroutine mesh_spectral_build_elements(fileUnit) enddo enddo - elemType = FE_mapElemtype('C3D8R') + elemType = FE_mapElemtype('C3D8R') elemOffset = product(grid(1:2))*grid3Offset e = 0_pInt do while (e < mesh_NcpElems) ! fill expected number of elements, stop at end of data (or blank line!) @@ -1376,7 +1389,7 @@ subroutine mesh_spectral_build_elements(fileUnit) mesh_element(11,e) = mesh_element(9,e) + grid(1) + 2_pInt mesh_element(12,e) = mesh_element(9,e) + grid(1) + 1_pInt mesh_maxValStateVar(1) = max(mesh_maxValStateVar(1),mesh_element(3,e)) ! needed for statistics - mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) + mesh_maxValStateVar(2) = max(mesh_maxValStateVar(2),mesh_element(4,e)) enddo deallocate(microstructures) @@ -1397,7 +1410,7 @@ subroutine mesh_spectral_build_ipNeighborhood x,y,z, & e allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems),source=0_pInt) - + e = 0_pInt do z = 0_pInt,grid3-1_pInt do y = 0_pInt,grid(2)-1_pInt @@ -1451,7 +1464,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) debug_levelBasic use math, only: & math_mul33x3 - + implicit none real(pReal), intent(in), dimension(:,:,:,:) :: & centres @@ -1489,7 +1502,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) iRes = [size(centres,2),size(centres,3),size(centres,4)] nodes = 0.0_pReal wrappedCentres = 0.0_pReal - + !-------------------------------------------------------------------------------------------------- ! report if (iand(debug_level(debug_mesh),debug_levelBasic) /= 0_pInt) then @@ -1515,7 +1528,7 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) - math_mul33x3(Favg, real(shift,pReal)*gDim) endif enddo; enddo; enddo - + !-------------------------------------------------------------------------------------------------- ! averaging do k = 0_pInt,iRes(3); do j = 0_pInt,iRes(2); do i = 0_pInt,iRes(1) @@ -1530,10 +1543,41 @@ function mesh_nodesAroundCentres(gDim,Favg,centres) result(nodes) end function mesh_nodesAroundCentres #endif - + #ifdef Marc4DAMASK !-------------------------------------------------------------------------------------------------- -!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and +!> @brief Figures out version of Marc input file format and stores ist as MarcVersion +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_fileFormat(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then + MarcVersion = IO_intValue(line,chunkPos,2_pInt) + exit + endif + enddo + +620 end subroutine mesh_marc_get_fileFormat + + +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out table styles (Marc only) and stores to 'initialcondTableStyle' and !! 'hypoelasticTableStyle' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_get_tableStyles(fileUnit) @@ -1542,20 +1586,20 @@ subroutine mesh_marc_get_tableStyles(fileUnit) IO_intValue, & IO_stringValue, & IO_stringPos - + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line initialcondTableStyle = 0_pInt hypoelasticTableStyle = 0_pInt - + 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) @@ -1568,6 +1612,52 @@ subroutine mesh_marc_get_tableStyles(fileUnit) 620 end subroutine mesh_marc_get_tableStyles +!-------------------------------------------------------------------------------------------------- +!> @brief Figures out material number of hypoelastic material and stores it in Marc_matNumber array +!-------------------------------------------------------------------------------------------------- +subroutine mesh_marc_get_matNumber(fileUnit) + use IO, only: & + IO_lc, & + IO_intValue, & + IO_stringValue, & + IO_stringPos + + implicit none + integer(pInt), intent(in) :: fileUnit + + integer(pInt), allocatable, dimension(:) :: chunkPos + integer(pInt) :: i, j, data_blocks + character(len=300) line + +610 FORMAT(A300) + + rewind(fileUnit) + + data_blocks = 1_pInt + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + read (fileUnit,610,END=620) line + if (len(trim(line))/=0_pInt) then + chunkPos = IO_stringPos(line) + data_blocks = IO_intValue(line,chunkPos,1_pInt) + endif + allocate(Marc_matNumber(data_blocks)) + do i=1_pInt,data_blocks ! read all data blocks + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + Marc_matNumber(i) = IO_intValue(line,chunkPos,1_pInt) + do j=1_pint,2_pInt + hypoelasticTableStyle ! read 2 or 3 remaining lines of data block + read (fileUnit,610,END=620) line + enddo + enddo + exit + endif + enddo + +620 end subroutine mesh_marc_get_matNumber + !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of nodes and elements in mesh and stores the numbers in @@ -1579,10 +1669,10 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_stringValue, & IO_stringPos, & IO_IntValue - + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line @@ -1592,7 +1682,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) @@ -1619,7 +1709,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) IO_stringValue, & IO_stringPos, & IO_countContinuousIntValues - + implicit none integer(pInt), intent(in) :: fileUnit @@ -1632,7 +1722,7 @@ subroutine mesh_marc_count_nodesAndElements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) @@ -1661,7 +1751,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: elemSet = 0_pInt @@ -1683,7 +1773,7 @@ subroutine mesh_marc_map_elementSets(fileUnit) IO_continuousIntValues(fileUnit,mesh_maxNelemInSet,mesh_nameElemSet,mesh_mapElemSet,mesh_NelemSets) endif enddo - + 640 end subroutine mesh_marc_map_elementSets @@ -1697,13 +1787,14 @@ subroutine mesh_marc_count_cpElements(fileUnit) IO_stringPos, & IO_countContinuousIntValues, & IO_error, & - IO_intValue - + IO_intValue, & + IO_countNumericalDataLines + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: i, version + integer(pInt) :: i character(len=300):: line mesh_NcpElems = 0_pInt @@ -1711,29 +1802,31 @@ subroutine mesh_marc_count_cpElements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do - read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'version') then - version = IO_intValue(line,chunkPos,2_pInt) - if (version < 13) then ! Marc 2016 or earlier - rewind(fileUnit) - do + if (MarcVersion < 13) then ! Marc 2016 or earlier + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines read (fileUnit,610,END=620) line - chunkPos = IO_stringPos(line) - if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic') then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! Skip 3 or 4 lines - read (fileUnit,610,END=620) line - enddo - mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? keyword hypoelastic might appear several times - exit - endif enddo - else ! Marc2017 and later - call IO_error(error_ID=701_pInt) - end if - end if - enddo + mesh_NcpElems = mesh_NcpElems + IO_countContinuousIntValues(fileUnit) ! why not simply mesh_NcpElems = IO_countContinuousIntValues(fileUnit)? not fully correct as hypoelastic can have multiple data fields, needs update + exit + endif + enddo + else ! Marc2017 and later + do + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=620) line + chunkPos = IO_stringPos(line) + if (any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + mesh_NcpElems = mesh_NcpElems + IO_countNumericalDataLines(fileUnit) + endif + endif + enddo + end if 620 end subroutine mesh_marc_count_cpElements @@ -1746,6 +1839,7 @@ subroutine mesh_marc_map_elements(fileUnit) use math, only: math_qsort use IO, only: IO_lc, & + IO_intValue, & IO_stringValue, & IO_stringPos, & IO_continuousIntValues @@ -1754,7 +1848,8 @@ subroutine mesh_marc_map_elements(fileUnit) integer(pInt), intent(in) :: fileUnit integer(pInt), allocatable, dimension(:) :: chunkPos - character(len=300) :: line + character(len=300) :: line, & + tmp integer(pInt), dimension (1_pInt+mesh_NcpElems) :: contInts integer(pInt) :: i,cpElem = 0_pInt @@ -1763,25 +1858,47 @@ subroutine mesh_marc_map_elements(fileUnit) 610 FORMAT(A300) + contInts = 0_pInt rewind(fileUnit) do read (fileUnit,610,END=660) line chunkPos = IO_stringPos(line) - if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then - do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines - read (fileUnit,610,END=660) line - enddo - contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& + if (MarcVersion < 13) then ! Marc 2016 or earlier + if( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'hypoelastic' ) then + do i=1_pInt,3_pInt+hypoelasticTableStyle ! skip three (or four if new table style!) lines + read (fileUnit,610,END=660) line + enddo + contInts = IO_continuousIntValues(fileUnit,mesh_NcpElems,mesh_nameElemSet,& mesh_mapElemSet,mesh_NelemSets) - do i = 1_pInt,contInts(1) - cpElem = cpElem+1_pInt - mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) - mesh_mapFEtoCPelem(2,cpElem) = cpElem - enddo - endif - enddo - -660 call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems + exit + endif + else ! Marc2017 and later + if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == 'connectivity') then + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + if(any(Marc_matNumber==IO_intValue(line,chunkPos,6_pInt))) then + do + read (fileUnit,610,END=660) line + chunkPos = IO_stringPos(line) + tmp = IO_lc(IO_stringValue(line,chunkPos,1_pInt)) + if (verify(trim(tmp),"0123456789")/=0) then ! found keyword + exit + else + contInts(1) = contInts(1) + 1_pInt + read (tmp,*) contInts(contInts(1)+1) + endif + enddo + endif + endif + endif + enddo +660 do i = 1_pInt,contInts(1) + cpElem = cpElem+1_pInt + mesh_mapFEtoCPelem(1,cpElem) = contInts(1_pInt+i) + mesh_mapFEtoCPelem(2,cpElem) = cpElem + enddo + +call math_qsort(mesh_mapFEtoCPelem,1_pInt,int(size(mesh_mapFEtoCPelem,2_pInt),pInt)) ! should be mesh_NcpElems end subroutine mesh_marc_map_elements @@ -1797,7 +1914,7 @@ subroutine mesh_marc_map_nodes(fileUnit) IO_stringValue, & IO_stringPos, & IO_fixedIntValue - + implicit none integer(pInt), intent(in) :: fileUnit @@ -1829,7 +1946,7 @@ subroutine mesh_marc_map_nodes(fileUnit) enddo 650 call math_qsort(mesh_mapFEtoCPnode,1_pInt,int(size(mesh_mapFEtoCPnode,2_pInt),pInt)) - + end subroutine mesh_marc_map_nodes @@ -1883,11 +2000,11 @@ end subroutine mesh_marc_build_nodes !-------------------------------------------------------------------------------------------------- !> @brief Gets maximum count of nodes, IPs, IP neighbors, and cellnodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- subroutine mesh_marc_count_cpSizes(fileUnit) - + use IO, only: IO_lc, & IO_stringValue, & IO_stringPos, & @@ -1896,7 +2013,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line integer(pInt) :: i,t,g,e,c @@ -1905,7 +2022,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNips = 0_pInt mesh_maxNipNeighbors = 0_pInt mesh_maxNcellnodes = 0_pInt - + 610 FORMAT(A300) rewind(fileUnit) do @@ -1915,7 +2032,7 @@ subroutine mesh_marc_count_cpSizes(fileUnit) read (fileUnit,610,END=630) line ! Garbage line do i=1_pInt,mesh_Nelems ! read all elements read (fileUnit,610,END=630) line - chunkPos = IO_stringPos(line) ! limit to id and type + chunkPos = IO_stringPos(line) ! limit to id and type e = mesh_FEasCP('elem',IO_intValue(line,chunkPos,1_pInt)) if (e /= 0_pInt) then t = FE_mapElemtype(IO_stringValue(line,chunkPos,2_pInt)) @@ -1925,13 +2042,13 @@ subroutine mesh_marc_count_cpSizes(fileUnit) mesh_maxNips = max(mesh_maxNips,FE_Nips(g)) mesh_maxNipNeighbors = max(mesh_maxNipNeighbors,FE_NipNeighbors(c)) mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) - call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line + call IO_skipChunks(fileUnit,FE_Nnodes(t)-(chunkPos(1_pInt)-2_pInt)) ! read on if FE_Nnodes exceeds node count present on current line endif enddo exit endif enddo - + 630 end subroutine mesh_marc_count_cpSizes @@ -1979,7 +2096,7 @@ subroutine mesh_marc_build_elements(fileUnit) nNodesAlreadyRead = 0_pInt do j = 1_pInt,chunkPos(1)-2_pInt mesh_element(4_pInt+j,e) = mesh_FEasCP('node',IO_IntValue(line,chunkPos,j+2_pInt)) ! CP ids of nodes - enddo + enddo nNodesAlreadyRead = chunkPos(1) - 2_pInt do while(nNodesAlreadyRead < FE_Nnodes(t)) ! read on if not all nodes in one line read (fileUnit,610,END=620) line @@ -1995,7 +2112,7 @@ subroutine mesh_marc_build_elements(fileUnit) exit endif enddo - + 620 rewind(fileUnit) ! just in case "initial state" appears before "connectivity" read (fileUnit,610,END=620) line do @@ -2027,13 +2144,13 @@ subroutine mesh_marc_build_elements(fileUnit) chunkPos = IO_stringPos(line) enddo endif - else + else read (fileUnit,610,END=630) line endif enddo 630 end subroutine mesh_marc_build_elements -#endif +#endif #ifdef Abaqus !-------------------------------------------------------------------------------------------------- @@ -2047,28 +2164,28 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) IO_stringPos, & IO_countDataLines, & IO_error - + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line logical :: inPart mesh_Nnodes = 0_pInt mesh_Nelems = 0_pInt - + 610 FORMAT(A300) inPart = .false. rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - + if (inPart .or. noPart) then select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt))) case('*node') @@ -2090,10 +2207,10 @@ subroutine mesh_abaqus_count_nodesAndElements(fileUnit) endselect endif enddo - + 620 if (mesh_Nnodes < 2_pInt) call IO_error(error_ID=900_pInt) if (mesh_Nelems == 0_pInt) call IO_error(error_ID=901_pInt) - + end subroutine mesh_abaqus_count_nodesAndElements @@ -2114,21 +2231,21 @@ subroutine mesh_abaqus_count_elementSets(fileUnit) integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line logical :: inPart - + mesh_NelemSets = 0_pInt mesh_maxNelemInSet = mesh_Nelems ! have to be conservative, since Abaqus allows for recursive definitons - + 610 FORMAT(A300) inPart = .false. rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) & mesh_NelemSets = mesh_NelemSets + 1_pInt enddo @@ -2153,18 +2270,18 @@ subroutine mesh_abaqus_count_materials(fileUnit) implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) :: line logical inPart - + mesh_Nmaterials = 0_pInt - + 610 FORMAT(A300) inPart = .false. rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. @@ -2178,12 +2295,12 @@ subroutine mesh_abaqus_count_materials(fileUnit) enddo 620 if (mesh_Nmaterials == 0_pInt) call IO_error(error_ID=903_pInt) - + end subroutine mesh_abaqus_count_materials !-------------------------------------------------------------------------------------------------- -! Build element set mapping +! Build element set mapping ! ! allocate globals: mesh_nameElemSet, mesh_mapElemSet !-------------------------------------------------------------------------------------------------- @@ -2217,7 +2334,7 @@ subroutine mesh_abaqus_map_elementSets(fileUnit) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*end' .and. & IO_lc(IO_stringValue(line,chunkPos,2_pInt)) == 'part' ) inPart = .false. - + if ( (inPart .or. noPart) .and. IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*elset' ) then elemSet = elemSet + 1_pInt mesh_nameElemSet(elemSet) = trim(IO_extractValue(IO_lc(IO_stringValue(line,chunkPos,2_pInt)),'elset')) @@ -2255,14 +2372,14 @@ subroutine mesh_abaqus_map_materials(fileUnit) integer(pInt) :: i,c = 0_pInt logical :: inPart = .false. character(len=64) :: elemSetName,materialName - + allocate (mesh_nameMaterial(mesh_Nmaterials)) ; mesh_nameMaterial = '' allocate (mesh_mapMaterial(mesh_Nmaterials)) ; mesh_mapMaterial = '' 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) if ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) == '*part' ) inPart = .true. @@ -2287,7 +2404,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) c = c + 1_pInt mesh_nameMaterial(c) = materialName ! name of material used for this section mesh_mapMaterial(c) = elemSetName ! mapped to respective element set - endif + endif endif enddo @@ -2297,7 +2414,7 @@ subroutine mesh_abaqus_map_materials(fileUnit) enddo end subroutine mesh_abaqus_map_materials - + !-------------------------------------------------------------------------------------------------- !> @brief Count overall number of CP elements in mesh and stores them in 'mesh_NcpElems' @@ -2309,22 +2426,22 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) IO_stringPos, & IO_error, & IO_extractValue - + implicit none integer(pInt), intent(in) :: fileUnit - + integer(pInt), allocatable, dimension(:) :: chunkPos character(len=300) line integer(pInt) :: i,k logical :: materialFound = .false. character(len=64) ::materialName,elemSetName - + mesh_NcpElems = 0_pInt - + 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) @@ -2346,7 +2463,7 @@ subroutine mesh_abaqus_count_cpElements(fileUnit) endif endselect enddo - + 620 if (mesh_NcpElems == 0_pInt) call IO_error(error_ID=906_pInt) end subroutine mesh_abaqus_count_cpElements @@ -2364,7 +2481,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) IO_stringPos, & IO_extractValue, & IO_error - + implicit none integer(pInt), intent(in) :: fileUnit @@ -2379,7 +2496,7 @@ subroutine mesh_abaqus_map_elements(fileUnit) 610 FORMAT(A300) rewind(fileUnit) - do + do read (fileUnit,610,END=660) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_stringValue(line,chunkPos,1_pInt)) ) @@ -2498,7 +2615,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) character(len=300) :: line integer(pInt) :: i,j,m,c logical :: inPart - + allocate ( mesh_node0 (3,mesh_Nnodes) ); mesh_node0 = 0.0_pReal allocate ( mesh_node (3,mesh_Nnodes) ); mesh_node = 0.0_pReal @@ -2530,7 +2647,7 @@ subroutine mesh_abaqus_build_nodes(fileUnit) m = mesh_FEasCP('node',IO_intValue(line,chunkPos,1_pInt)) do j=1_pInt, 3_pInt mesh_node0(j,m) = mesh_unitlength * IO_floatValue(line,chunkPos,j+1_pInt) - enddo + enddo enddo endif enddo @@ -2543,7 +2660,7 @@ end subroutine mesh_abaqus_build_nodes !-------------------------------------------------------------------------------------------------- !> @brief Gets maximum count of nodes, IPs, IP neighbors, and subNodes among cpElements. -!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', +!! Sets global values 'mesh_maxNnodes', 'mesh_maxNips', 'mesh_maxNipNeighbors', !! and 'mesh_maxNcellnodes' !-------------------------------------------------------------------------------------------------- subroutine mesh_abaqus_count_cpSizes(fileUnit) @@ -2595,7 +2712,7 @@ subroutine mesh_abaqus_count_cpSizes(fileUnit) mesh_maxNcellnodes = max(mesh_maxNcellnodes,FE_Ncellnodes(g)) endif enddo - + 620 end subroutine mesh_abaqus_count_cpSizes @@ -2675,11 +2792,11 @@ subroutine mesh_abaqus_build_elements(fileUnit) endif enddo - + 620 rewind(fileUnit) ! just in case "*material" definitions apear before "*element" materialFound = .false. - do + do read (fileUnit,610,END=630) line chunkPos = IO_stringPos(line) select case ( IO_lc(IO_StringValue(line,chunkPos,1_pInt))) @@ -2735,14 +2852,14 @@ use IO, only: & integer(pInt), allocatable, dimension(:) :: chunkPos integer(pInt) chunk, Nchunks character(len=300) :: line, damaskOption, v - character(len=300) :: keyword + character(len=300) :: keyword #endif #ifdef Spectral mesh_periodicSurface = .true. #else mesh_periodicSurface = .false. -#ifdef Marc4DAMASK +#ifdef Marc4DAMASK keyword = '$damask' #endif #ifdef Abaqus @@ -2750,7 +2867,7 @@ use IO, only: & #endif rewind(fileUnit) - do + do read (fileUnit,610,END=620) line chunkPos = IO_stringPos(line) Nchunks = chunkPos(1) @@ -2780,7 +2897,7 @@ use IO, only: & subroutine mesh_build_ipAreas use math, only: & math_crossproduct - + implicit none integer(pInt) :: e,t,g,c,i,f,n,m real(pReal), dimension (3,FE_maxNcellnodesPerCellface) :: nodePos, normals @@ -2822,10 +2939,10 @@ subroutine mesh_build_ipAreas enddo case (4_pInt) ! 3D 8node - ! for this cell type we get the normal of the quadrilateral face as an average of + ! for this cell type we get the normal of the quadrilateral face as an average of ! four normals of triangular subfaces; since the face consists only of two triangles, - ! the sum has to be divided by two; this whole prcedure tries to compensate for - ! probable non-planar cell surfaces + ! the sum has to be divided by two; this whole prcedure tries to compensate for + ! probable non-planar cell surfaces m = FE_NcellnodesPerCellface(c) do i = 1_pInt,FE_Nips(g) ! loop over ips=cells in this element do f = 1_pInt,FE_NipNeighbors(c) ! loop over cell faces @@ -2844,10 +2961,10 @@ subroutine mesh_build_ipAreas end select enddo !$OMP END PARALLEL DO - + end subroutine mesh_build_ipAreas - -#ifndef Spectral + +#ifndef Spectral !-------------------------------------------------------------------------------------------------- !> @brief assignment of twin nodes for each cp node, allocate globals '_nodeTwins' !-------------------------------------------------------------------------------------------------- @@ -2865,19 +2982,19 @@ subroutine mesh_build_nodeTwins tolerance ! tolerance below which positions are assumed identical real(pReal), dimension(3) :: distance ! distance between two nodes in all three coordinates logical, dimension(mesh_Nnodes) :: unpaired - + allocate(mesh_nodeTwins(3,mesh_Nnodes)) mesh_nodeTwins = 0_pInt - + tolerance = 0.001_pReal * minval(mesh_ipVolume) ** 0.333_pReal - + do dir = 1_pInt,3_pInt ! check periodicity in directions of x,y,z if (mesh_periodicSurface(dir)) then ! only if periodicity is requested - - - !*** find out which nodes sit on the surface + + + !*** find out which nodes sit on the surface !*** and have a minimum or maximum position in this dimension - + minimumNodes = 0_pInt maximumNodes = 0_pInt minCoord = minval(mesh_node0(dir,:)) @@ -2891,10 +3008,10 @@ subroutine mesh_build_nodeTwins maximumNodes(maximumNodes(1)+1_pInt) = node endif enddo - - + + !*** find the corresponding node on the other side with the same position in this dimension - + unpaired = .true. do n1 = 1_pInt,minimumNodes(1) minimumNode = minimumNodes(n1+1_pInt) @@ -2911,15 +3028,15 @@ subroutine mesh_build_nodeTwins enddo endif enddo - + endif enddo - + end subroutine mesh_build_nodeTwins !-------------------------------------------------------------------------------------------------- -!> @brief get maximum count of shared elements among cpElements and build list of elements shared +!> @brief get maximum count of shared elements among cpElements and build list of elements shared !! by each node in mesh. Allocate globals '_maxNsharedElems' and '_sharedElem' !-------------------------------------------------------------------------------------------------- subroutine mesh_build_sharedElems @@ -2928,17 +3045,16 @@ subroutine mesh_build_sharedElems integer(pint) e, & ! element index g, & ! element type node, & ! CP node index - n, & ! node index per element - myDim, & ! dimension index + n, & ! node index per element + myDim, & ! dimension index nodeTwin ! node twin in the specified dimension integer(pInt), dimension (mesh_Nnodes) :: node_count integer(pInt), dimension (:), allocatable :: node_seen - + allocate(node_seen(maxval(FE_NmatchingNodes))) - - + node_count = 0_pInt - + do e = 1_pInt,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType node_seen = 0_pInt ! reset node duplicates @@ -2955,12 +3071,12 @@ subroutine mesh_build_sharedElems node_seen(n) = node ! remember this node to be counted already enddo enddo - + mesh_maxNsharedElems = int(maxval(node_count),pInt) ! most shared node - + allocate(mesh_sharedElem(1+mesh_maxNsharedElems,mesh_Nnodes)) mesh_sharedElem = 0_pInt - + do e = 1_pInt,mesh_NcpElems g = FE_geomtype(mesh_element(2,e)) ! get elemGeomType node_seen = 0_pInt @@ -2980,9 +3096,9 @@ subroutine mesh_build_sharedElems node_seen(n) = node enddo enddo - + deallocate(node_seen) - + end subroutine mesh_build_sharedElems @@ -2992,14 +3108,14 @@ end subroutine mesh_build_sharedElems subroutine mesh_build_ipNeighborhood use math, only: & math_mul3x3 - + implicit none integer(pInt) :: myElem, & ! my CP element index myIP, & myType, & ! my element type myFace, & neighbor, & ! neighor index - neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) + neighboringIPkey, & ! positive integer indicating the neighboring IP (for intra-element) and negative integer indicating the face towards neighbor (for neighboring element) candidateIP, & neighboringType, & ! element type of neighbor NlinkedNodes, & ! number of linked nodes @@ -3009,52 +3125,52 @@ subroutine mesh_build_ipNeighborhood matchingElem, & ! CP elem number of matching element matchingFace, & ! face ID of matching element a, anchor, & - neighboringIP, & + neighboringIP, & neighboringElem, & pointingToMe integer(pInt), dimension(FE_maxmaxNnodesAtIP) :: & linkedNodes = 0_pInt, & matchingNodes logical checkTwins - + allocate(mesh_ipNeighborhood(3,mesh_maxNipNeighbors,mesh_maxNips,mesh_NcpElems)) mesh_ipNeighborhood = 0_pInt - - + + do myElem = 1_pInt,mesh_NcpElems ! loop over cpElems myType = FE_geomtype(mesh_element(2,myElem)) ! get elemGeomType do myIP = 1_pInt,FE_Nips(myType) ! loop over IPs of elem - + do neighbor = 1_pInt,FE_NipNeighbors(FE_celltype(myType)) ! loop over neighbors of IP neighboringIPkey = FE_ipNeighbor(neighbor,myIP,myType) - + !*** if the key is positive, the neighbor is inside the element !*** that means, we have already found our neighboring IP - + if (neighboringIPkey > 0_pInt) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = myElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = neighboringIPkey - - + + !*** if the key is negative, the neighbor resides in a neighboring element !*** that means, we have to look through the face indicated by the key and see which element is behind that face - + elseif (neighboringIPkey < 0_pInt) then ! neighboring element's IP myFace = -neighboringIPkey call mesh_faceMatch(myElem, myFace, matchingElem, matchingFace) ! get face and CP elem id of face match if (matchingElem > 0_pInt) then ! found match? neighboringType = FE_geomtype(mesh_element(2,matchingElem)) - + !*** trivial solution if neighbor has only one IP - - if (FE_Nips(neighboringType) == 1_pInt) then + + if (FE_Nips(neighboringType) == 1_pInt) then mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = 1_pInt cycle endif - + !*** find those nodes which build the link to the neighbor - + NlinkedNodes = 0_pInt linkedNodes = 0_pInt do a = 1_pInt,FE_maxNnodesAtIP(myType) ! figure my anchor nodes on connecting face @@ -3070,11 +3186,11 @@ subroutine mesh_build_ipNeighborhood endif endif enddo - + !*** loop through the ips of my neighbor !*** and try to find an ip with matching nodes !*** also try to match with node twins - + checkCandidateIP: do candidateIP = 1_pInt,FE_Nips(neighboringType) NmatchingNodes = 0_pInt matchingNodes = 0_pInt @@ -3091,12 +3207,12 @@ subroutine mesh_build_ipNeighborhood endif endif enddo - + if (NmatchingNodes /= NlinkedNodes) & ! this ip has wrong count of anchors on face cycle checkCandidateIP - + !*** check "normal" nodes whether they match or not - + checkTwins = .false. do a = 1_pInt,NlinkedNodes if (all(matchingNodes /= linkedNodes(a))) then ! this linkedNode does not match any matchingNode @@ -3104,9 +3220,9 @@ subroutine mesh_build_ipNeighborhood exit ! no need to search further endif enddo - + !*** if no match found, then also check node twins - + if(checkTwins) then dir = int(maxloc(abs(mesh_ipAreaNormal(1:3,neighbor,myIP,myElem)),1),pInt) ! check for twins only in direction of the surface normal do a = 1_pInt,NlinkedNodes @@ -3117,12 +3233,12 @@ subroutine mesh_build_ipNeighborhood endif enddo endif - + !*** we found a match !!! - + mesh_ipNeighborhood(1,neighbor,myIP,myElem) = matchingElem mesh_ipNeighborhood(2,neighbor,myIP,myElem) = candidateIP - exit checkCandidateIP + exit checkCandidateIP enddo checkCandidateIP endif ! end of valid external matching endif ! end of internal/external matching @@ -3151,7 +3267,7 @@ subroutine mesh_build_ipNeighborhood enddo enddo enddo - + end subroutine mesh_build_ipNeighborhood #endif @@ -3177,12 +3293,12 @@ subroutine mesh_tell_statistics integer(pInt), dimension (:,:), allocatable :: mesh_HomogMicro character(len=64) :: myFmt integer(pInt) :: i,e,n,f,t,g,c, myDebug - + myDebug = debug_level(debug_mesh) if (mesh_maxValStateVar(1) < 1_pInt) call IO_error(error_ID=170_pInt) ! no homogenization specified if (mesh_maxValStateVar(2) < 1_pInt) call IO_error(error_ID=180_pInt) ! no microstructure specified - + allocate (mesh_HomogMicro(mesh_maxValStateVar(1),mesh_maxValStateVar(2))); mesh_HomogMicro = 0_pInt do e = 1_pInt,mesh_NcpElems if (mesh_element(3,e) < 1_pInt) call IO_error(error_ID=170_pInt,el=e) ! no homogenization specified @@ -3266,7 +3382,7 @@ enddo if (iand(myDebug,debug_levelSelective) /= 0_pInt .and. debug_i /= i) cycle write(6,'(i8,1x,i5,3(1x,f12.8))') e, i, mesh_ipCoordinates(:,i,e) enddo - enddo + enddo #ifndef Spectral write(6,'(/,a,/)') 'Input Parser: NODE TWINS' write(6,'(a6,3(3x,a6))') ' node','twin_x','twin_y','twin_z' @@ -3293,7 +3409,7 @@ enddo !$OMP END CRITICAL (write2out) deallocate(mesh_HomogMicro) - + end subroutine mesh_tell_statistics @@ -3305,7 +3421,7 @@ integer(pInt) function FE_mapElemtype(what) implicit none character(len=*), intent(in) :: what - + select case (IO_lc(what)) case ( '6') FE_mapElemtype = 1_pInt ! Two-dimensional Plane Strain Triangle @@ -3352,7 +3468,7 @@ integer(pInt) function FE_mapElemtype(what) 'c3d20', & 'c3d20t') FE_mapElemtype = 13_pInt ! Three-dimensional Arbitrarily Distorted quadratic hexahedral - case default + case default call IO_error(error_ID=190_pInt,ext_msg=IO_lc(what)) end select @@ -3366,7 +3482,7 @@ subroutine mesh_faceMatch(elem, face ,matchingElem, matchingFace) implicit none integer(pInt), intent(out) :: matchingElem, & ! matching CP element ID - matchingFace ! matching face ID + matchingFace ! matching face ID integer(pInt), intent(in) :: face, & ! face ID elem ! CP elem ID integer(pInt), dimension(FE_NmatchingNodesPerFace(face,FE_geomtype(mesh_element(2,elem)))) :: & @@ -3581,7 +3697,7 @@ subroutine mesh_build_FEdata 7,0, 0,0 & ],pInt),[FE_maxNnodesAtIP(me),FE_Nips(me)]) - + ! *** FE_ipNeighbor *** ! is a list of the neighborhood of each IP. ! It is sorted in (local) +x,-x, +y,-y, +z,-z direction. @@ -3594,7 +3710,7 @@ subroutine mesh_build_FEdata reshape(int([& -2,-3,-1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - + me = me + 1_pInt FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 125 (2D 6node 3ip) reshape(int([& @@ -3602,7 +3718,7 @@ subroutine mesh_build_FEdata -2, 1, 3,-1, & 2,-3,-2, 1 & ],pInt),[FE_NipNeighbors(FE_celltype(me)),FE_Nips(me)]) - + me = me + 1_pInt FE_ipNeighbor(1:FE_NipNeighbors(FE_celltype(me)),1:FE_Nips(me),me) = & ! element 11 (2D 4node 4ip) reshape(int([& @@ -3831,32 +3947,32 @@ subroutine mesh_build_FEdata me = 0_pInt me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 6 (2D 3node 1ip) reshape(real([& - 1, 0, 0, & - 0, 1, 0, & + 1, 0, 0, & + 0, 1, 0, & 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) me = me + 1_pInt FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 125 (2D 6node 3ip) reshape(real([& - 1, 0, 0, 0, 0, 0, & - 0, 1, 0, 0, 0, 0, & + 1, 0, 0, 0, 0, 0, & + 0, 1, 0, 0, 0, 0, & 0, 0, 1, 0, 0, 0, & 0, 0, 0, 1, 0, 0, & 0, 0, 0, 0, 1, 0, & 0, 0, 0, 0, 0, 1, & 1, 1, 1, 2, 2, 2 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) - + me = me + 1_pInt FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 11 (2D 4node 4ip) reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & + 1, 0, 0, 0, & + 0, 1, 0, 0, & 0, 0, 1, 0, & - 0, 0, 0, 1, & + 0, 0, 0, 1, & 1, 1, 0, 0, & 0, 1, 1, 0, & 0, 0, 1, 1, & @@ -3900,16 +4016,16 @@ subroutine mesh_build_FEdata ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 134 (3D 4node 1ip) reshape(real([& - 1, 0, 0, 0, & - 0, 1, 0, 0, & + 1, 0, 0, 0, & + 0, 1, 0, 0, & 0, 0, 1, 0, & - 0, 0, 0, 1 & + 0, 0, 0, 1 & ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 157 (3D 5node 4ip) reshape(real([& 1, 0, 0, 0, 0, & 0, 1, 0, 0, 0, & @@ -3975,7 +4091,7 @@ subroutine mesh_build_FEdata ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) me = me + 1_pInt - FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) + FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 117 (3D 8node 1ip) reshape(real([& 1, 0, 0, 0, 0, 0, 0, 0, & 0, 1, 0, 0, 0, 0, 0, 0, & @@ -3990,134 +4106,134 @@ subroutine mesh_build_FEdata me = me + 1_pInt FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 7 (3D 8node 8ip) reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, & ! 0, 0, 0, 0, 1, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, & ! - 1, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, & ! + 1, 1, 0, 0, 0, 0, 0, 0, & ! 0, 1, 1, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 1, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 1, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 1, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 1, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 1, 0, 0, & ! 0, 0, 1, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 1, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 1, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 1, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 1, & ! + 0, 0, 0, 1, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 1, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 1, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 1, & ! 0, 0, 0, 0, 1, 0, 0, 1, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, & ! + 1, 1, 1, 1, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, & ! 1, 0, 0, 1, 1, 0, 0, 1, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, & ! - 1, 1, 1, 1, 1, 1, 1, 1 & ! + 0, 0, 0, 0, 1, 1, 1, 1, & ! + 1, 1, 1, 1, 1, 1, 1, 1 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) me = me + 1_pInt FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 57 (3D 20node 8ip) reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 - 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! - 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! - 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! - 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 - 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! - 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, & ! 15 + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, & ! 20 + 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, & ! + 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, & ! + 0, 0, 1, 1, 0, 0, 1, 1, 0, 0, 2, 0, 0, 0, 2, 0, 0, 0, 2, 2, & ! + 1, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 2, 2, 0, 0, 2, & ! 25 + 0, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 2, 2, 2, 2, 0, 0, 0, 0, & ! + 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) me = me + 1_pInt FE_cellnodeParentnodeWeights(1:FE_Nnodes(me),1:FE_Ncellnodes(FE_geomtype(me)),me) = & ! element 21 (3D 20node 27ip) reshape(real([& - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 - 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 - 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! - 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 - 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! - 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! - 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 - 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! - 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! - 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! - 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 - 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! - 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! - 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! - 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! - 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 - 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! - 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! - 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! - 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 - 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! - 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! - 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! - 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! - 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 - 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! - 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! - 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! - 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 5 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! 10 + 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 15 + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! 20 + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! 25 + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, 0, & ! 30 + 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 0, 0, 0, 0, & ! + 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, 0, 0, 0, 0, & ! 35 + 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, 0, 0, 0, 0, & ! + 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, & ! + 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, 0, & ! 40 + 0, 0, 4, 1, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 4, 0, 0, 1, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 0, 2, 8, & ! + 1, 0, 0, 4, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 2, 0, 0, 8, & ! + 4, 0, 0, 1, 1, 0, 0, 1, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, 2, & ! + 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, 0, & ! 45 + 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, 0, & ! + 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, 0, & ! + 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, 0, & ! + 0, 0, 1, 1, 0, 0, 4, 1, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 8, 2, & ! + 0, 0, 1, 1, 0, 0, 1, 4, 0, 0, 2, 0, 0, 0, 8, 0, 0, 0, 2, 8, & ! 50 + 1, 0, 0, 1, 1, 0, 0, 4, 0, 0, 0, 2, 0, 0, 0, 8, 2, 0, 0, 8, & ! + 1, 0, 0, 1, 4, 0, 0, 1, 0, 0, 0, 2, 0, 0, 0, 8, 8, 0, 0, 2, & ! + 0, 0, 0, 0, 4, 1, 1, 1, 0, 0, 0, 0, 8, 2, 2, 8, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 4, 1, 1, 0, 0, 0, 0, 8, 8, 2, 2, 0, 0, 0, 0, & ! + 0, 0, 0, 0, 1, 1, 4, 1, 0, 0, 0, 0, 2, 8, 8, 2, 0, 0, 0, 0, & ! 55 + 0, 0, 0, 0, 1, 1, 1, 4, 0, 0, 0, 0, 2, 2, 8, 8, 0, 0, 0, 0, & ! + 24, 8, 4, 8, 8, 4, 3, 4, 32,12,12,32, 12, 4, 4,12, 32,12, 4,12, & ! + 8,24, 8, 4, 4, 8, 4, 3, 32,32,12,12, 12,12, 4, 4, 12,32,12, 4, & ! + 4, 8,24, 8, 3, 4, 8, 4, 12,32,32,12, 4,12,12, 4, 4,12,32,12, & ! + 8, 4, 8,24, 4, 3, 4, 8, 12,12,32,32, 4, 4,12,12, 12, 4,12,32, & ! 60 + 8, 4, 3, 4, 24, 8, 4, 8, 12, 4, 4,12, 32,12,12,32, 32,12, 4,12, & ! + 4, 8, 4, 3, 8,24, 8, 4, 12,12, 4, 4, 32,32,12,12, 12,32,12, 4, & ! + 3, 4, 8, 4, 4, 8,24, 8, 4,12,12, 4, 12,32,32,12, 4,12,32,12, & ! + 4, 3, 4, 8, 8, 4, 8,24, 4, 4,12,12, 12,12,32,32, 12, 4,12,32 & ! ],pReal),[FE_Nnodes(me),FE_Ncellnodes(FE_geomtype(me))]) @@ -4172,7 +4288,7 @@ end subroutine mesh_build_FEdata integer(pInt) function mesh_get_Ncellnodes() implicit none - + mesh_get_Ncellnodes = mesh_Ncellnodes end function mesh_get_Ncellnodes @@ -4184,7 +4300,7 @@ end function mesh_get_Ncellnodes real(pReal) function mesh_get_unitlength() implicit none - + mesh_get_unitlength = mesh_unitlength end function mesh_get_unitlength diff --git a/src/numerics.f90 b/src/numerics.f90 index 2085e221e..70c7f3c30 100644 --- a/src/numerics.f90 +++ b/src/numerics.f90 @@ -25,7 +25,7 @@ module numerics nState = 10_pInt, & !< state loop limit nStress = 40_pInt, & !< stress loop limit pert_method = 1_pInt, & !< method used in perturbation technique for tangent - fixedSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed + randomSeed = 0_pInt, & !< fixed seeding for pseudo-random number generator, Default 0: use random seed worldrank = 0_pInt, & !< MPI worldrank (/=0 for MPI simulations only) worldsize = 0_pInt !< MPI worldsize (/=0 for MPI simulations only) integer(4), protected, public :: & @@ -359,8 +359,8 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! random seeding parameter - case ('fixed_seed') - fixedSeed = IO_intValue(line,chunkPos,2_pInt) + case ('random_seed','fixed_seed') + randomSeed = IO_intValue(line,chunkPos,2_pInt) !-------------------------------------------------------------------------------------------------- ! gradient parameter @@ -560,9 +560,9 @@ subroutine numerics_init !-------------------------------------------------------------------------------------------------- ! Random seeding parameter - write(6,'(a24,1x,i16,/)') ' fixed_seed: ',fixedSeed - if (fixedSeed <= 0_pInt) & - write(6,'(a,/)') ' No fixed Seed: Random is random!' + write(6,'(a24,1x,i16,/)') ' random_seed: ',randomSeed + if (randomSeed <= 0_pInt) & + write(6,'(a,/)') ' random seed will be generated!' !-------------------------------------------------------------------------------------------------- ! gradient parameter diff --git a/src/plastic_disloUCLA.f90 b/src/plastic_disloUCLA.f90 index 75e087770..c02a7c4d4 100644 --- a/src/plastic_disloUCLA.f90 +++ b/src/plastic_disloUCLA.f90 @@ -1178,7 +1178,7 @@ end subroutine plastic_disloUCLA_dotState function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) use prec, only: & tol_math_check, & - dEq + dEq, dNeq0 use math, only: & pi use material, only: & @@ -1445,9 +1445,13 @@ function plastic_disloUCLA_postResults(Tstar_v,Temperature,ipc,ip,el) index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family slipSystems2: do i = 1_pInt,plastic_disloUCLA_Nslip(f,instance) j = j + 1_pInt + if (dNeq0(abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph))))) then plastic_disloUCLA_postResults(c+j) = & (3.0_pReal*lattice_mu(ph)*plastic_disloUCLA_burgersPerSlipSystem(j,instance))/& (16.0_pReal*pi*abs(dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)))) + else + plastic_disloUCLA_postResults(c+j) = huge(1.0_pReal) + endif plastic_disloUCLA_postResults(c+j)=min(plastic_disloUCLA_postResults(c+j),& state(instance)%mfp_slip(j,of)) enddo slipSystems2; enddo slipFamilies2 diff --git a/src/plastic_dislotwin.f90 b/src/plastic_dislotwin.f90 index 50b14bdf9..d6c73e8f3 100644 --- a/src/plastic_dislotwin.f90 +++ b/src/plastic_dislotwin.f90 @@ -1029,7 +1029,7 @@ subroutine plastic_dislotwin_init(fileUnit) do p = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt plastic_dislotwin_Ctwin3333(l,m,n,o,index_myFamily+j,instance) = & plastic_dislotwin_Ctwin3333(l,m,n,o,index_myFamily+j,instance) + & - lattice_C3333(p,q,r,s,instance) * & + lattice_C3333(p,q,r,s,phase) * & lattice_Qtwin(l,p,index_otherFamily+j,phase) * & lattice_Qtwin(m,q,index_otherFamily+j,phase) * & lattice_Qtwin(n,r,index_otherFamily+j,phase) * & @@ -1087,7 +1087,7 @@ subroutine plastic_dislotwin_init(fileUnit) do p = 1_pInt,3_pInt; do q = 1_pInt,3_pInt; do r = 1_pInt,3_pInt; do s = 1_pInt,3_pInt plastic_dislotwin_Ctrans3333(l,m,n,o,index_myFamily+j,instance) = & plastic_dislotwin_Ctrans3333(l,m,n,o,index_myFamily+j,instance) + & - lattice_trans_C3333(p,q,r,s,instance) * & + lattice_trans_C3333(p,q,r,s,phase) * & lattice_Qtrans(l,p,index_otherFamily+j,phase) * & lattice_Qtrans(m,q,index_otherFamily+j,phase) * & lattice_Qtrans(n,r,index_otherFamily+j,phase) * & diff --git a/src/plastic_nonlocal.f90 b/src/plastic_nonlocal.f90 index 0a8c4c3f9..55871737d 100644 --- a/src/plastic_nonlocal.f90 +++ b/src/plastic_nonlocal.f90 @@ -1823,14 +1823,14 @@ plasticState(ph)%state(iRhoF(1:ns,instance),of) = rhoForest plasticState(ph)%state(iTauF(1:ns,instance),of) = tauThreshold plasticState(ph)%state(iTauB(1:ns,instance),of) = tauBack -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_microstructure at el ip ',el,ip write(6,'(a,/,12x,12(e10.3,1x))') '<< CONST >> rhoForest', rhoForest - write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold/1e6 - write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', tauBack/1e6 + write(6,'(a,/,12x,12(f10.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold*1e-6 + write(6,'(a,/,12x,12(f10.5,1x),/)') '<< CONST >> tauBack / MPa', tauBack*1e-6 endif #endif @@ -1978,15 +1978,15 @@ if (Temperature > 0.0_pReal) then endif -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_kinetics at el ip',el,ip - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold / 1e6_pReal - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau / 1e6_pReal - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS / 1e6_pReal - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> v / 1e-3m/s', v * 1e3 + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauThreshold / MPa', tauThreshold * 1e-6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tau / MPa', tau * 1e-6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> tauNS / MPa', tauNS * 1e-6_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> v / mm/s', v * 1e3 write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtau', dv_dtau write(6,'(a,/,12x,12(e12.5,1x))') '<< CONST >> dv_dtauNS', dv_dtauNS endif @@ -2176,12 +2176,12 @@ enddo dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_LpandItsTangent at el ip',el,ip - write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> gdot total / 1e-3',gdotTotal*1e3_pReal + write(6,'(a,/,12x,12(f12.5,1x))') '<< CONST >> gdot total',gdotTotal write(6,'(a,/,3(12x,3(f12.7,1x),/))') '<< CONST >> Lp',transpose(Lp) endif #endif @@ -2248,7 +2248,7 @@ real(pReal), dimension(totalNslip(phase_plasticityInstance(material_phase(1,ip,e dUpperOld, & ! old maximum stable dipole distance for edges and screws deltaDUpper ! change in maximum stable dipole distance for edges and screws -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & @@ -2361,7 +2361,7 @@ forall (s = 1:ns, c = 1_pInt:2_pInt) & plasticState(ph)%deltaState(iRhoD(s,c,instance),of) = deltaRho(s,c+8_pInt) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then @@ -2522,11 +2522,11 @@ logical considerEnteringFlux, & -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt)) & - write(6,'(/,a,i8,1x,i2,1x,i1,/)') '<< CONST >> nonlocal_dotState at el ip ',el,ip + write(6,'(/,a,i8,1x,i2,/)') '<< CONST >> nonlocal_dotState at el ip ',el,ip #endif ph = material_phase(1_pInt,ip,el) @@ -2589,7 +2589,7 @@ endif forall (t = 1_pInt:4_pInt) & gdot(1_pInt:ns,t) = rhoSgl(1_pInt:ns,t) * burgers(1:ns,instance) * v(1:ns,t) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelBasic) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then @@ -2663,7 +2663,7 @@ else / burgers(s,instance) * sqrt(rhoForest(s)) / lambda0(s,instance) endif enddo -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) & @@ -2690,7 +2690,7 @@ if (.not. phase_localPlasticity(material_phase(1_pInt,ip,el))) then if (any( abs(gdot) > 0.0_pReal & ! any active slip system ... .and. CFLfactor(instance) * abs(v) * timestep & > mesh_ipVolume(ip,el) / maxval(mesh_ipArea(:,ip,el)))) then ! ...with velocity above critical value (we use the reference volume and area for simplicity here) -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then write(6,'(a,i5,a,i2)') '<< CONST >> CFL condition not fullfilled at el ',el,' ip ',ip write(6,'(a,e10.3,a,e10.3)') '<< CONST >> velocity is at ', & @@ -2952,7 +2952,7 @@ if (numerics_integrationMode == 1_pInt) then endif -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt & .and. ((debug_e == el .and. debug_i == ip .and. debug_g == 1_pInt)& .or. .not. iand(debug_level(debug_constitutive),debug_levelSelective) /= 0_pInt )) then @@ -2978,7 +2978,7 @@ endif if ( any(rhoSglOriginal(1:ns,1:4) + rhoDot(1:ns,1:4) * timestep < -aTolRho(instance)) & .or. any(rhoDipOriginal(1:ns,1:2) + rhoDot(1:ns,9:10) * timestep < -aTolRho(instance))) then -#ifndef _OPENMP +#ifdef DEBUG if (iand(debug_level(debug_constitutive),debug_levelExtensive) /= 0_pInt) then write(6,'(a,i5,a,i2)') '<< CONST >> evolution rate leads to negative density at el ',el,' ip ',ip write(6,'(a)') '<< CONST >> enforcing cutback !!!' diff --git a/src/plastic_phenoplus.f90 b/src/plastic_phenoplus.f90 deleted file mode 100644 index e0e5ed1b5..000000000 --- a/src/plastic_phenoplus.f90 +++ /dev/null @@ -1,1416 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @author Chen Zhang, Michigan State University -!> @brief material subroutine for phenomenological crystal plasticity formulation using a powerlaw -!... fitting -!-------------------------------------------------------------------------------------------------- -module plastic_phenoplus - use prec, only: & - pReal,& - pInt - - implicit none - private - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenoplus_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_phenoplus_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_phenoplus_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_phenoplus_Noutput !< number of outputs per instance of this constitution - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_phenoplus_totalNslip, & !< no. of slip system used in simulation - plastic_phenoplus_totalNtwin, & !< no. of twin system used in simulation - plastic_phenoplus_totalNtrans !< no. of trans system used in simulation - - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_phenoplus_Nslip, & !< active number of slip systems per family (input parameter, per family) - plastic_phenoplus_Ntwin, & !< active number of twin systems per family (input parameter, per family) - plastic_phenoplus_Ntrans !< active number of trans systems per family (input parameter, per family) - - real(pReal), dimension(:), allocatable, private :: & - plastic_phenoplus_gdot0_slip, & !< reference shear strain rate for slip (input parameter) - plastic_phenoplus_gdot0_twin, & !< reference shear strain rate for twin (input parameter) - plastic_phenoplus_n_slip, & !< stress exponent for slip (input parameter) - plastic_phenoplus_n_twin, & !< stress exponent for twin (input parameter) - plastic_phenoplus_spr, & !< push-up factor for slip saturation due to twinning - plastic_phenoplus_twinB, & - plastic_phenoplus_twinC, & - plastic_phenoplus_twinD, & - plastic_phenoplus_twinE, & - plastic_phenoplus_h0_SlipSlip, & !< reference hardening slip - slip (input parameter) - plastic_phenoplus_h0_TwinSlip, & !< reference hardening twin - slip (input parameter) - plastic_phenoplus_h0_TwinTwin, & !< reference hardening twin - twin (input parameter) - plastic_phenoplus_a_slip, & - plastic_phenoplus_aTolResistance, & - plastic_phenoplus_aTolShear, & - plastic_phenoplus_aTolTwinfrac, & - plastic_phenoplus_aTolTransfrac, & - plastic_phenoplus_Cnuc, & !< coefficient for strain-induced martensite nucleation - plastic_phenoplus_Cdwp, & !< coefficient for double well potential - plastic_phenoplus_Cgro, & !< coefficient for stress-assisted martensite growth - plastic_phenoplus_deltaG, & !< free energy difference between austensite and martensite [MPa] - plastic_phenoplus_kappa_max !< capped kappa for each slip system - - real(pReal), dimension(:,:), allocatable, private :: & - plastic_phenoplus_tau0_slip, & !< initial critical shear stress for slip (input parameter, per family) - plastic_phenoplus_tau0_twin, & !< initial critical shear stress for twin (input parameter, per family) - plastic_phenoplus_tausat_slip, & !< maximum critical shear stress for slip (input parameter, per family) - plastic_phenoplus_nonSchmidCoeff, & - - plastic_phenoplus_interaction_SlipSlip, & !< interaction factors slip - slip (input parameter) - plastic_phenoplus_interaction_SlipTwin, & !< interaction factors slip - twin (input parameter) - plastic_phenoplus_interaction_TwinSlip, & !< interaction factors twin - slip (input parameter) - plastic_phenoplus_interaction_TwinTwin !< interaction factors twin - twin (input parameter) - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_phenoplus_hardeningMatrix_SlipSlip, & - plastic_phenoplus_hardeningMatrix_SlipTwin, & - plastic_phenoplus_hardeningMatrix_TwinSlip, & - plastic_phenoplus_hardeningMatrix_TwinTwin - - enum, bind(c) - enumerator :: undefined_ID, & - resistance_slip_ID, & - accumulatedshear_slip_ID, & - shearrate_slip_ID, & - resolvedstress_slip_ID, & - kappa_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_phenoplus_outputID !< ID of each post result output - - public :: & - plastic_phenoplus_init, & - plastic_phenoplus_microstructure, & - plastic_phenoplus_LpAndItsTangent, & - plastic_phenoplus_dotState, & - plastic_phenoplus_postResults - private :: & - plastic_phenoplus_aTolState, & - plastic_phenoplus_stateInit - - -contains - - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_init(fileUnit) -#ifdef __GFORTRAN__ - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use prec, only: & - dEq0 - use debug, only: & - debug_level, & - debug_constitutive,& - debug_levelBasic - use math, only: & - math_Mandel3333to66, & - math_Voigt66to3333 - 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 - use material, only: & - phase_plasticity, & - phase_plasticityInstance, & - phase_Noutput, & - PLASTICITY_PHENOPLUS_label, & - PLASTICITY_PHENOPLUS_ID, & - material_phase, & - plasticState, & - MATERIAL_partPhase - 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 - character(len=65536) :: & - tag = '', & - line = '' - real(pReal), dimension(:), allocatable :: tempPerSlip - - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_PHENOPLUS_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_plasticity == PLASTICITY_PHENOPLUS_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_phenoplus_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_sizePostResult(maxval(phase_Noutput),maxNinstance), & - source=0_pInt) - allocate(plastic_phenoplus_output(maxval(phase_Noutput),maxNinstance)) - plastic_phenoplus_output = '' - allocate(plastic_phenoplus_outputID(maxval(phase_Noutput),maxNinstance),source=undefined_ID) - allocate(plastic_phenoplus_Noutput(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_Ntrans(lattice_maxNtransFamily,maxNinstance),source=0_pInt) - allocate(plastic_phenoplus_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_totalNtrans(maxNinstance), source=0_pInt) - allocate(plastic_phenoplus_gdot0_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_n_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_tau0_slip(lattice_maxNslipFamily,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_tausat_slip(lattice_maxNslipFamily,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_gdot0_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_n_twin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_tau0_twin(lattice_maxNtwinFamily,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_spr(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinB(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinC(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinD(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_twinE(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_h0_SlipSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_h0_TwinSlip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_h0_TwinTwin(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_interaction_SlipSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_interaction_SlipTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_interaction_TwinSlip(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_interaction_TwinTwin(lattice_maxNinteraction,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_a_slip(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolResistance(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolShear(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolTwinfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_aTolTransfrac(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_nonSchmidCoeff(lattice_maxNnonSchmid,maxNinstance), & - source=0.0_pReal) - allocate(plastic_phenoplus_Cnuc(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_Cdwp(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_Cgro(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_deltaG(maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_kappa_max(maxNinstance), source=0.0_pReal) - - 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_PHENOPLUS_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_PHENOPLUS_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_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resistance_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear_slip','accumulated_shear_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = accumulatedshear_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = shearrate_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resolvedstress_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('kappa_slip') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = kappa_slip_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('totalshear') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = totalshear_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resistance_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('accumulatedshear_twin','accumulated_shear_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = accumulatedshear_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shearrate_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = shearrate_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resolvedstress_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = resolvedstress_twin_ID - plastic_phenoplus_output(plastic_phenoplus_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('totalvolfrac_twin') - plastic_phenoplus_Noutput(instance) = plastic_phenoplus_Noutput(instance) + 1_pInt - plastic_phenoplus_outputID(plastic_phenoplus_Noutput(instance),instance) = totalvolfrac_twin_ID - plastic_phenoplus_output(plastic_phenoplus_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_PHENOPLUS_label//')') - if (chunkPos(1) > Nchunks_SlipFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_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_phenoplus_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('tausat_slip','tau0_slip') - tempPerSlip = 0.0_pReal - do j = 1_pInt, Nchunks_SlipFamilies - if (plastic_phenoplus_Nslip(j,instance) > 0_pInt) & - tempPerSlip(j) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - select case(tag) - case ('tausat_slip') - plastic_phenoplus_tausat_slip(1:Nchunks_SlipFamilies,instance) = tempPerSlip(1:Nchunks_SlipFamilies) - case ('tau0_slip') - plastic_phenoplus_tau0_slip(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_PHENOPLUS_label//')') - if (chunkPos(1) > Nchunks_TwinFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - Nchunks_TwinFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TwinFamilies - plastic_phenoplus_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0_twin') - do j = 1_pInt, Nchunks_TwinFamilies - if (plastic_phenoplus_Ntwin(j,instance) > 0_pInt) & - plastic_phenoplus_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(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - if (chunkPos(1) > Nchunks_TransFamilies + 1_pInt) & - call IO_error(150_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_PHENOPLUS_label//')') - Nchunks_TransFamilies = chunkPos(1) - 1_pInt - do j = 1_pInt, Nchunks_TransFamilies - plastic_phenoplus_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_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_SlipSlip - plastic_phenoplus_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_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_SlipTwin - plastic_phenoplus_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_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_TwinSlip - plastic_phenoplus_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_PHENOPLUS_label//')') - do j = 1_pInt, Nchunks_TwinTwin - plastic_phenoplus_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_PHENOPLUS_label//')') - do j = 1_pInt,Nchunks_nonSchmid - plastic_phenoplus_nonSchmidCoeff(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo -!-------------------------------------------------------------------------------------------------- -! parameters independent of number of slip/twin systems - case ('gdot0_slip') - plastic_phenoplus_gdot0_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('n_slip') - plastic_phenoplus_n_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('a_slip', 'w0_slip') - plastic_phenoplus_a_slip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('gdot0_twin') - plastic_phenoplus_gdot0_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('n_twin') - plastic_phenoplus_n_twin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('s_pr') - plastic_phenoplus_spr(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_b') - plastic_phenoplus_twinB(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_c') - plastic_phenoplus_twinC(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_d') - plastic_phenoplus_twinD(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twin_e') - plastic_phenoplus_twinE(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_slipslip') - plastic_phenoplus_h0_SlipSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twinslip') - plastic_phenoplus_h0_TwinSlip(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('h0_twintwin') - plastic_phenoplus_h0_TwinTwin(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_resistance') - plastic_phenoplus_aTolResistance(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_shear') - plastic_phenoplus_aTolShear(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_twinfrac') - plastic_phenoplus_aTolTwinfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_transfrac') - plastic_phenoplus_aTolTransfrac(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('kappa_max') - plastic_phenoplus_kappa_max(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cnuc') - plastic_phenoplus_Cnuc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cdwp') - plastic_phenoplus_Cdwp(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('cgro') - plastic_phenoplus_Cgro(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('deltag') - plastic_phenoplus_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_phenoplus_ID) then - instance = phase_plasticityInstance(phase) - plastic_phenoplus_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_phenoplus_Nslip(1:lattice_maxNslipFamily,instance)) - plastic_phenoplus_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_phenoplus_Ntwin(:,instance)) - plastic_phenoplus_totalNslip(instance) = sum(plastic_phenoplus_Nslip(:,instance)) ! how many slip systems altogether - plastic_phenoplus_totalNtwin(instance) = sum(plastic_phenoplus_Ntwin(:,instance)) ! how many twin systems altogether - plastic_phenoplus_totalNtrans(instance) = sum(plastic_phenoplus_Ntrans(:,instance)) ! how many trans systems altogether - - if (any(plastic_phenoplus_tau0_slip(:,instance) < 0.0_pReal .and. & - plastic_phenoplus_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (plastic_phenoplus_gdot0_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (plastic_phenoplus_n_slip(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='n_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (any(plastic_phenoplus_tausat_slip(:,instance) <= 0.0_pReal .and. & - plastic_phenoplus_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tausat_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (any(dEq0(plastic_phenoplus_a_slip(instance)) .and. plastic_phenoplus_Nslip(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='a_slip ('//PLASTICITY_PHENOPLUS_label//')') - if (any(plastic_phenoplus_tau0_twin(:,instance) < 0.0_pReal .and. & - plastic_phenoplus_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='tau0_twin ('//PLASTICITY_PHENOPLUS_label//')') - if ( plastic_phenoplus_gdot0_twin(instance) <= 0.0_pReal .and. & - any(plastic_phenoplus_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='gdot0_twin ('//PLASTICITY_PHENOPLUS_label//')') - if ( plastic_phenoplus_n_twin(instance) <= 0.0_pReal .and. & - any(plastic_phenoplus_Ntwin(:,instance) > 0)) & - call IO_error(211_pInt,el=instance,ext_msg='n_twin ('//PLASTICITY_PHENOPLUS_label//')') - if (plastic_phenoplus_aTolResistance(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolResistance(instance) = 1.0_pReal ! default absolute tolerance 1 Pa - if (plastic_phenoplus_aTolShear(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolShear(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenoplus_aTolTwinfrac(instance) <= 0.0_pReal) & - plastic_phenoplus_aTolTwinfrac(instance) = 1.0e-6_pReal ! default absolute tolerance 1e-6 - if (plastic_phenoplus_aTolTransfrac(instance) <= 0.0_pReal) & - plastic_phenoplus_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_phenoplus_hardeningMatrix_SlipSlip(maxval(plastic_phenoplus_totalNslip),& ! slip resistance from slip activity - maxval(plastic_phenoplus_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_hardeningMatrix_SlipTwin(maxval(plastic_phenoplus_totalNslip),& ! slip resistance from twin activity - maxval(plastic_phenoplus_totalNtwin),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_hardeningMatrix_TwinSlip(maxval(plastic_phenoplus_totalNtwin),& ! twin resistance from slip activity - maxval(plastic_phenoplus_totalNslip),& - maxNinstance), source=0.0_pReal) - allocate(plastic_phenoplus_hardeningMatrix_TwinTwin(maxval(plastic_phenoplus_totalNtwin),& ! twin resistance from twin activity - maxval(plastic_phenoplus_totalNtwin),& - maxNinstance), source=0.0_pReal) - - initializeInstances: do phase = 1_pInt, size(phase_plasticity) ! loop through all phases in material.config - myPhase2: if (phase_plasticity(phase) == PLASTICITY_phenoplus_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 - -!-------------------------------------------------------------------------------------------------- -! Determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_phenoplus_Noutput(instance) - select case(plastic_phenoplus_outputID(o,instance)) - case(resistance_slip_ID, & - shearrate_slip_ID, & - accumulatedshear_slip_ID, & - resolvedstress_slip_ID, & - kappa_slip_ID & - ) - mySize = plastic_phenoplus_totalNslip(instance) - case(resistance_twin_ID, & - shearrate_twin_ID, & - accumulatedshear_twin_ID, & - resolvedstress_twin_ID & - ) - mySize = plastic_phenoplus_totalNtwin(instance) - case(totalshear_ID, & - totalvolfrac_twin_ID & - ) - mySize = 1_pInt - case default - end select - - outputFound: if (mySize > 0_pInt) then - plastic_phenoplus_sizePostResult(o,instance) = mySize - plastic_phenoplus_sizePostResults(instance) = plastic_phenoplus_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop -!-------------------------------------------------------------------------------------------------- -! allocate state arrays - sizeState = plastic_phenoplus_totalNslip(instance) & ! s_slip - + plastic_phenoplus_totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenoplus_totalNslip(instance) & ! accshear_slip - + plastic_phenoplus_totalNtwin(instance) & ! accshear_twin - + plastic_phenoplus_totalNslip(instance) ! kappa - - !sizeDotState = sizeState ! same as sizeState - !QUICK FIX: the dotState cannot have redundancy, which could cause unknown error - ! explicitly specify the size of the dotState to avoid this potential - ! memory leak issue. - sizeDotState = plastic_phenoplus_totalNslip(instance) & ! s_slip - + plastic_phenoplus_totalNtwin(instance) & ! s_twin - + 2_pInt & ! sum(gamma) + sum(f) - + plastic_phenoplus_totalNslip(instance) & ! accshear_slip - + plastic_phenoplus_totalNtwin(instance) ! accshear_twin - - sizeDeltaState = 0_pInt - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_phenoplus_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_phenoplus_totalNslip(instance) - plasticState(phase)%nTwin =plastic_phenoplus_totalNtwin(instance) - plasticState(phase)%nTrans=plastic_phenoplus_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) - - 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_phenoplus_Nslip(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenoplus_Nslip(f,instance) ! loop over (active) systems in my family (slip) - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenoplus_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenoplus_hardeningMatrix_SlipSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_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_phenoplus_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenoplus_hardeningMatrix_SlipTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_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_phenoplus_Ntwin(1:f-1_pInt,instance)) - do j = 1_pInt,plastic_phenoplus_Ntwin(f,instance) ! loop over (active) systems in my family (twin) - - do o = 1_pInt,lattice_maxNslipFamily - index_otherFamily = sum(plastic_phenoplus_Nslip(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Nslip(o,instance) ! loop over (active) systems in other family (slip) - plastic_phenoplus_hardeningMatrix_TwinSlip(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_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_phenoplus_Ntwin(1:o-1_pInt,instance)) - do k = 1_pInt,plastic_phenoplus_Ntwin(o,instance) ! loop over (active) systems in other family (twin) - plastic_phenoplus_hardeningMatrix_TwinTwin(index_myFamily+j,index_otherFamily+k,instance) = & - plastic_phenoplus_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 - - call plastic_phenoplus_stateInit(phase,instance) - call plastic_phenoplus_aTolState(phase,instance) - endif myPhase2 - enddo initializeInstances - -end subroutine plastic_phenoplus_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_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_phenoplus_Nslip(1:i-1,instance)) : & - sum(plastic_phenoplus_Nslip(1:i ,instance))) = & - plastic_phenoplus_tau0_slip(i,instance) - enddo - - do i = 1_pInt,lattice_maxNtwinFamily - tempState(1+sum(plastic_phenoplus_Nslip(:,instance))+& - sum(plastic_phenoplus_Ntwin(1:i-1,instance)) : & - sum(plastic_phenoplus_Nslip(:,instance))+& - sum(plastic_phenoplus_Ntwin(1:i ,instance))) = & - plastic_phenoplus_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_phenoplus_stateInit - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the relevant state values for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_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_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance)) = & - plastic_phenoplus_aTolResistance(instance) - plasticState(ph)%aTolState(1+plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance)) = & - plastic_phenoplus_aTolShear(instance) - plasticState(ph)%aTolState(2+plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance)) = & - plastic_phenoplus_aTolTwinFrac(instance) - plasticState(ph)%aTolState(3+plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance): & - 2+2*(plastic_phenoplus_totalNslip(instance)+ & - plastic_phenoplus_totalNtwin(instance))) = & - plastic_phenoplus_aTolShear(instance) - -end subroutine plastic_phenoplus_aTolState - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculate push-up factors (kappa) for each voxel based on its neighbors -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_microstructure(orientation,ipc,ip,el) - use math, only: pi, & - math_mul33x33, & - math_mul3x3, & - math_transpose33, & - math_qDot, & - math_qRot, & - indeg - - use mesh, only: mesh_element, & - FE_NipNeighbors, & - FE_geomtype, & - FE_celltype, & - mesh_maxNips, & - mesh_NcpElems, & - mesh_ipNeighborhood - - use material, only: material_phase, & - material_texture, & - phase_plasticityInstance, & - phaseAt, phasememberAt, & - homogenization_maxNgrains, & - plasticState - - use lattice, only: lattice_sn, & - lattice_sd, & - lattice_qDisorientation - - !***input variables - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(4,homogenization_maxNgrains,mesh_maxNips,mesh_NcpElems), intent(in) :: & - orientation ! crystal orientation in quaternions - - !***local variables - integer(pInt) instance, & !my instance of this plasticity - ph, & !my phase - of, & !my spatial position in memory (offset) - textureID, & !my texture - Nneighbors, & !number of neighbors (<= 6) - vld_Nneighbors, & !number of my valid neighbors - n, & !neighbor index (for iterating through all neighbors) - ns, & !number of slip system - nt, & !number of twin system - me_slip, & !my slip system index - neighbor_el, & !element number of neighboring material point - neighbor_ip, & !integration point of neighboring material point - neighbor_n, & !I have no idea what is this - neighbor_of, & !spatial position in memory for this neighbor (offset) - neighbor_ph, & !neighbor's phase - neighbor_tex, & !neighbor's texture ID - ne_slip_ac, & !loop to find neighbor shear - ne_slip, & !slip system index for neighbor - index_kappa, & !index of pushup factors in plasticState - offset_acshear_slip, & !offset in PlasticState for the accumulative shear - j !quickly loop through slip families - - real(pReal) kappa_max, & ! - tmp_myshear_slip, & !temp storage for accumulative shear for me - mprime_cut, & !m' cutoff to consider neighboring effect - avg_acshear_ne, & !the average accumulative shear from my neighbor - tmp_mprime, & !temp holder for m' value - tmp_acshear !temp holder for accumulative shear for m' - - - real(pReal), dimension(plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - m_primes, & !m' between me_alpha(one) and neighbor beta(all) - me_acshear, & !temp storage for ac_shear of one particular system for me - ne_acshear !temp storage for ac_shear of one particular system for one of my neighbor - - real(pReal), dimension(3,plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(1,ip,el)))) :: & - slipNormal, & - slipDirect - - real(pReal), dimension(4) :: my_orientation, & !store my orientation - neighbor_orientation, & !store my neighbor orientation - absMisorientation - - real(pReal), dimension(FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el))))) :: & - ne_mprimes !m' between each neighbor - - !***Get my properties - Nneighbors = FE_NipNeighbors(FE_celltype(FE_geomtype(mesh_element(2,el)))) - ph = phaseAt(ipc,ip,el) !get my phase - of = phasememberAt(ipc,ip,el) !get my spatial location offset in memory - textureID = material_texture(1,ip,el) !get my texture ID - instance = phase_plasticityInstance(ph) !get my instance based on phase ID - ns = plastic_phenoplus_totalNslip(instance) - nt = plastic_phenoplus_totalNtwin(instance) - offset_acshear_slip = ns + nt + 2_pInt - index_kappa = ns + nt + 2_pInt + ns + nt !location of kappa in plasticState - mprime_cut = 0.7_pReal !set by Dr.Bieler - - !***gather my accumulative shear from palsticState - FINDMYSHEAR: do j = 1_pInt,ns - me_acshear(j) = plasticState(ph)%state(offset_acshear_slip+j, of) - enddo FINDMYSHEAR - - !***gather my orientation and slip systems - my_orientation = orientation(1:4, ipc, ip, el) - slipNormal(1:3, 1:ns) = lattice_sn(1:3, 1:ns, ph) - slipDirect(1:3, 1:ns) = lattice_sd(1:3, 1:ns, ph) - kappa_max = plastic_phenoplus_kappa_max(instance) !maximum pushups allowed (READIN) - - !***calculate kappa between me and all my neighbors - LOOPMYSLIP: DO me_slip=1_pInt,ns - vld_Nneighbors = Nneighbors - tmp_myshear_slip = me_acshear(me_slip) - tmp_mprime = 0.0_pReal !highest m' from all neighbors - tmp_acshear = 0.0_pReal !accumulative shear from highest m' - - !***go through my neighbors to find highest m' - LOOPNEIGHBORS: DO n=1_pInt,Nneighbors - neighbor_el = mesh_ipNeighborhood(1,n,ip,el) - neighbor_ip = mesh_ipNeighborhood(2,n,ip,el) - neighbor_n = 1 !It is ipc - neighbor_of = phasememberAt( neighbor_n, neighbor_ip, neighbor_el) - neighbor_ph = phaseAt( neighbor_n, neighbor_ip, neighbor_el) - neighbor_tex = material_texture(1,neighbor_ip,neighbor_el) - neighbor_orientation = orientation(1:4, neighbor_n, neighbor_ip, neighbor_el) !ipc is always 1. - absMisorientation = lattice_qDisorientation(my_orientation, & - neighbor_orientation, & - 0_pInt) !no need for explicit calculation of symmetry - - !***find the accumulative shear for this neighbor - LOOPFINDNEISHEAR: DO ne_slip_ac=1_pInt, ns - ne_acshear(ne_slip_ac) = plasticState(ph)%state(offset_acshear_slip+ne_slip_ac, & - neighbor_of) - ENDDO LOOPFINDNEISHEAR - - !***calculate the average accumulative shear and use it as cutoff - avg_acshear_ne = sum(ne_acshear)/real(ns,pReal) - - !*** - IF (ph==neighbor_ph) THEN - !***walk through all the - LOOPNEIGHBORSLIP: DO ne_slip=1_pInt,ns - !***only consider slip system that is active (above average accumulative shear) - IF (ne_acshear(ne_slip) > avg_acshear_ne) THEN - m_primes(ne_slip) = abs(math_mul3x3(slipNormal(1:3,me_slip), & - math_qRot(absMisorientation, slipNormal(1:3,ne_slip)))) & - *abs(math_mul3x3(slipDirect(1:3,me_slip), & - math_qRot(absMisorientation, slipDirect(1:3,ne_slip)))) - !***find the highest m' and corresponding accumulative shear - IF (m_primes(ne_slip) > tmp_mprime) THEN - tmp_mprime = m_primes(ne_slip) - tmp_acshear = ne_acshear(ne_slip) - ENDIF - ENDIF - ENDDO LOOPNEIGHBORSLIP - - ELSE - ne_mprimes(n) = 0.0_pReal - vld_Nneighbors = vld_Nneighbors - 1_pInt - ENDIF - - ENDDO LOOPNEIGHBORS - - !***check if this element close to rim - IF (vld_Nneighbors < Nneighbors) THEN - !***rim voxel, no modification allowed - plasticState(ph)%state(index_kappa+me_slip, of) = 1.0_pReal - ELSE - !***patch voxel, started to calculate push up factor for gamma_dot - IF ((tmp_mprime > mprime_cut) .AND. (tmp_acshear > tmp_myshear_slip)) THEN - plasticState(ph)%state(index_kappa+me_slip, of) = 1.0_pReal / tmp_mprime - ELSE - !***minimum damping factor is 0.5 - plasticState(ph)%state(index_kappa+me_slip, of) = 0.5_pReal + tmp_mprime * 0.5_pReal - ENDIF - ENDIF - - ENDDO LOOPMYSLIP - -end subroutine plastic_phenoplus_microstructure - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates plastic velocity gradient and its tangent -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,ipc,ip,el) - use prec, only: & - dNeq0 - use math, only: & - math_Plain3333to99, & - math_Mandel6to33 - use lattice, only: & - lattice_Sslip, & - lattice_Sslip_v, & - lattice_Stwin, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid - use material, only: & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress - - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - - integer(pInt) :: & - instance, & - nSlip, & - nTwin,index_Gamma,index_F,index_myFamily, index_kappa, & - f,i,j,k,l,m,n, & - of, & - ph - real(pReal) :: & - tau_slip_pos,tau_slip_neg, & - gdot_slip_pos,gdot_slip_neg, & - dgdot_dtauslip_pos,dgdot_dtauslip_neg, & - gdot_twin,dgdot_dtautwin,tau_twin - real(pReal), dimension(3,3,3,3) :: & - dLp_dTstar3333 !< derivative of Lp with respect to Tstar as 4th order tensor - real(pReal), dimension(3,3,2) :: & - nonSchmid_tensor - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - nSlip = plastic_phenoplus_totalNslip(instance) - nTwin = plastic_phenoplus_totalNtwin(instance) - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_kappa = nSlip + nTwin + 2_pInt +nSlip + nTwin - - Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal - dLp_dTstar99 = 0.0_pReal - -!-------------------------------------------------------------------------------------------------- -! Slip part - j = 0_pInt - slipFamilies: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j+1_pInt - - ! Calculation of Lp - tau_slip_pos = dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - 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_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - 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_phenoplus_nonSchmidCoeff(k,instance)*& - 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_phenoplus_nonSchmidCoeff(k,instance)*& - lattice_Sslip(1:3,1:3,2*k+1,index_myFamily+i,ph) - enddo - - !***insert non-local effect here by modify gdot with kappa in plastic state - !***this implementation will most likely cause convergence issue - ! gdot_slip_pos = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ! ((abs(tau_slip_pos)/(plasticState(ph)%state(j, of)* & - ! plasticState(ph)%state(j+index_kappa, of))) & !in-place modification of gdot - ! **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) - - ! gdot_slip_neg = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ! ((abs(tau_slip_neg)/(plasticState(ph)%state(j, of)* & - ! plasticState(ph)%state(j+index_kappa, of))) & !?should we make it direction aware - ! **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) - - !***original calculation - gdot_slip_pos = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j, of))) & !in-place modification of gdot - **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_pos) - - gdot_slip_neg = 0.5_pReal*plastic_phenoplus_gdot0_slip(instance)* & - ((abs(tau_slip_neg)/(plasticState(ph)%state(j, of))) & !?should we make it direction aware - **plastic_phenoplus_n_slip(instance))*sign(1.0_pReal,tau_slip_neg) - - !***MAGIC HERE***! - !***directly modify the amount of shear happens considering neighborhood - gdot_slip_pos = gdot_slip_pos * plasticState(ph)%state(j+index_kappa, of) - gdot_slip_neg = gdot_slip_neg * plasticState(ph)%state(j+index_kappa, of) - - Lp = Lp + (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - (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_phenoplus_n_slip(instance)/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_phenoplus_n_slip(instance)/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)* & - nonSchmid_tensor(m,n,2) - endif - enddo slipSystems - enddo slipFamilies - -!-------------------------------------------------------------------------------------------------- -! Twinning part - j = 0_pInt - twinFamilies: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - 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-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenoplus_gdot0_twin(instance)*& - (abs(tau_twin)/plasticState(ph)%state(nSlip+j,of))**& - plastic_phenoplus_n_twin(instance)*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_phenoplus_n_twin(instance)/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)* & - lattice_Stwin(m,n,index_myFamily+i,ph) - endif - enddo twinSystems - enddo twinFamilies - - dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) - - -end subroutine plastic_phenoplus_LpAndItsTangent - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -subroutine plastic_phenoplus_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 - use material, only: & - material_phase, & - phaseAt, phasememberAt, & - plasticState, & - phase_plasticityInstance - - implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state - - integer(pInt) :: & - instance,ph, & - nSlip,nTwin, & - f,i,j,k, & - index_Gamma,index_F,index_myFamily,& - offset_accshear_slip,offset_accshear_twin, offset_kappa, & - of - real(pReal) :: & - c_SlipSlip,c_TwinSlip,c_TwinTwin, & - ssat_offset, & - tau_slip_pos,tau_slip_neg,tau_twin - - real(pReal), dimension(plastic_phenoplus_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip,left_SlipSlip,left_SlipTwin,right_SlipSlip,right_TwinSlip - real(pReal), dimension(plastic_phenoplus_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin,left_TwinSlip,left_TwinTwin,right_SlipTwin,right_TwinTwin - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - - nSlip = plastic_phenoplus_totalNslip(instance) - nTwin = plastic_phenoplus_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 - offset_kappa = nSlip + nTwin + 2_pInt + nSlip + nTwin - plasticState(ph)%dotState(:,of) = 0.0_pReal - - -!-------------------------------------------------------------------------------------------------- -! system-independent (nonlinear) prefactors to M_Xx (X influenced by x) matrices - c_SlipSlip = plastic_phenoplus_h0_SlipSlip(instance)*& - (1.0_pReal + plastic_phenoplus_twinC(instance)*plasticState(ph)%state(index_F,of)**& - plastic_phenoplus_twinB(instance)) - c_TwinSlip = plastic_phenoplus_h0_TwinSlip(instance)*& - plasticState(ph)%state(index_Gamma,of)**plastic_phenoplus_twinE(instance) - c_TwinTwin = plastic_phenoplus_h0_TwinTwin(instance)*& - plasticState(ph)%state(index_F,of)**plastic_phenoplus_twinD(instance) - -!-------------------------------------------------------------------------------------------------- -! calculate left and right vectors and calculate dot gammas - ssat_offset = plastic_phenoplus_spr(instance)*sqrt(plasticState(ph)%state(index_F,of)) - j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j+1_pInt - left_SlipSlip(j) = 1.0_pReal ! no system-dependent left part - left_SlipTwin(j) = 1.0_pReal ! no system-dependent left part - !***original implementation - right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) & - **plastic_phenoplus_a_slip(instance)& - *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) - !***modify a_slip to get nonlocal effect - ! right_SlipSlip(j) = abs(1.0_pReal-plasticState(ph)%state(j,of) / & - ! (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) & - ! **(plastic_phenoplus_a_slip(instance)*plasticState(ph)%state(j+offset_kappa, of))& - ! *sign(1.0_pReal,1.0_pReal-plasticState(ph)%state(j,of) / & - ! (plastic_phenoplus_tausat_slip(f,instance)+ssat_offset)) - right_TwinSlip(j) = 1.0_pReal ! no system-dependent part - -!-------------------------------------------------------------------------------------------------- -! 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_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k, index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo nonSchmidSystems - gdot_slip(j) = plastic_phenoplus_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/(plasticState(ph)%state(j,of)))**plastic_phenoplus_n_slip(instance) & - +(abs(tau_slip_neg)/(plasticState(ph)%state(j,of)))**plastic_phenoplus_n_slip(instance))& - *sign(1.0_pReal,tau_slip_pos) - enddo slipSystems1 - enddo slipFamilies1 - - - j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - 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_phenoplus_gdot0_twin(instance)*& - (abs(tau_twin)/plasticState(ph)%state(nslip+j,of))**& - plastic_phenoplus_n_twin(instance)*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_phenoplus_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_phenoplus_hardeningMatrix_SlipSlip(j,1:nSlip,instance), & - right_SlipSlip*abs(gdot_slip)) + & ! dot gamma_slip modulated by right-side slip factor - dot_product(plastic_phenoplus_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 - - j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j+1_pInt - plasticState(ph)%dotState(j+nSlip,of) = & ! evolution of twin resistance j - c_TwinSlip * left_TwinSlip(j) * & - dot_product(plastic_phenoplus_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_phenoplus_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)) - enddo twinSystems2 - enddo twinFamilies2 - - -end subroutine plastic_phenoplus_dotState - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_phenoplus_postResults(Tstar_v,ipc,ip,el) - use material, only: & - material_phase, & - plasticState, & - phaseAt, phasememberAt, & - phase_plasticityInstance - use lattice, only: & - lattice_Sslip_v, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_NnonSchmid - - implicit none - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element !< microstructure state - - real(pReal), dimension(plastic_phenoplus_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - plastic_phenoplus_postResults - - integer(pInt) :: & - instance,ph, of, & - nSlip,nTwin, & - o,f,i,c,j,k, & - index_Gamma,index_F,index_accshear_slip,index_accshear_twin,index_myFamily,index_kappa - real(pReal) :: & - tau_slip_pos,tau_slip_neg,tau - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - - nSlip = plastic_phenoplus_totalNslip(instance) - nTwin = plastic_phenoplus_totalNtwin(instance) - - index_Gamma = nSlip + nTwin + 1_pInt - index_F = nSlip + nTwin + 2_pInt - index_accshear_slip = nSlip + nTwin + 2_pInt + 1_pInt - index_accshear_twin = nSlip + nTwin + 2_pInt + nSlip + 1_pInt - index_kappa = nSlip + nTwin + 2_pInt + nSlip + nTwin + 1_pInt - - plastic_phenoplus_postResults = 0.0_pReal - c = 0_pInt - - outputsLoop: do o = 1_pInt,plastic_phenoplus_Noutput(instance) - select case(plastic_phenoplus_outputID(o,instance)) - case (resistance_slip_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(1:nSlip,of) - c = c + nSlip - - case (accumulatedshear_slip_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = plasticState(ph)%state(index_accshear_slip:& - index_accshear_slip+nSlip-1_pInt,of) - c = c + nSlip - - case (shearrate_slip_ID) - j = 0_pInt - slipFamilies1: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems1: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - 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_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k,index_myFamily+i,ph)) - tau_slip_neg = tau_slip_neg + plastic_phenoplus_nonSchmidCoeff(k,instance)* & - dot_product(Tstar_v,lattice_Sslip_v(1:6,2*k+1,index_myFamily+i,ph)) - enddo - plastic_phenoplus_postResults(c+j) = plastic_phenoplus_gdot0_slip(instance)*0.5_pReal* & - ((abs(tau_slip_pos)/plasticState(ph)%state(j,of))**plastic_phenoplus_n_slip(instance) & - +(abs(tau_slip_neg)/plasticState(ph)%state(j,of))**plastic_phenoplus_n_slip(instance))& - *sign(1.0_pReal,tau_slip_pos) - - enddo slipSystems1 - enddo slipFamilies1 - c = c + nSlip - - case (resolvedstress_slip_ID) - j = 0_pInt - slipFamilies2: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - slipSystems2: do i = 1_pInt,plastic_phenoplus_Nslip(f,instance) - j = j + 1_pInt - plastic_phenoplus_postResults(c+j) = & - dot_product(Tstar_v,lattice_Sslip_v(1:6,1,index_myFamily+i,ph)) - enddo slipSystems2 - enddo slipFamilies2 - c = c + nSlip - - case (kappa_slip_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nSlip) = & - plasticState(ph)%state(index_kappa:index_kappa+nSlip-1_pInt,of) - c = c + nSlip - - case (totalshear_ID) - plastic_phenoplus_postResults(c+1_pInt) = & - plasticState(ph)%state(index_Gamma,of) - c = c + 1_pInt - - case (resistance_twin_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(1_pInt+nSlip:1_pInt+nSlip+nTwin-1_pInt,of) - c = c + nTwin - - case (accumulatedshear_twin_ID) - plastic_phenoplus_postResults(c+1_pInt:c+nTwin) = & - plasticState(ph)%state(index_accshear_twin:index_accshear_twin+nTwin-1_pInt,of) - c = c + nTwin - - case (shearrate_twin_ID) - j = 0_pInt - twinFamilies1: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems1: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j + 1_pInt - tau = dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - plastic_phenoplus_postResults(c+j) = (1.0_pReal-plasticState(ph)%state(index_F,of))*& ! 1-F - plastic_phenoplus_gdot0_twin(instance)*& - (abs(tau)/plasticState(ph)%state(j+nSlip,of))**& - plastic_phenoplus_n_twin(instance)*max(0.0_pReal,sign(1.0_pReal,tau)) - enddo twinSystems1 - enddo twinFamilies1 - c = c + nTwin - - case (resolvedstress_twin_ID) - j = 0_pInt - twinFamilies2: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - twinSystems2: do i = 1_pInt,plastic_phenoplus_Ntwin(f,instance) - j = j + 1_pInt - plastic_phenoplus_postResults(c+j) = & - dot_product(Tstar_v,lattice_Stwin_v(1:6,index_myFamily+i,ph)) - enddo twinSystems2 - enddo twinFamilies2 - c = c + nTwin - - case (totalvolfrac_twin_ID) - plastic_phenoplus_postResults(c+1_pInt) = plasticState(ph)%state(index_F,of) - c = c + 1_pInt - - end select - enddo outputsLoop - -end function plastic_phenoplus_postResults - -end module plastic_phenoplus diff --git a/src/plastic_titanmod.f90 b/src/plastic_titanmod.f90 deleted file mode 100644 index 169e3e4b5..000000000 --- a/src/plastic_titanmod.f90 +++ /dev/null @@ -1,1907 +0,0 @@ -!-------------------------------------------------------------------------------------------------- -!> @author Alankar Alankar, Max-Planck-Institut für Eisenforschung GmbH -!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH -!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH -!> @brief material subroutine for titanium -!-------------------------------------------------------------------------------------------------- -module plastic_titanmod - use prec, only: & - pReal, & - pInt - - implicit none - private - character(len=18), dimension(3), parameter, private :: & - plastic_titanmod_listBasicSlipStates = & - ['rho_edge ', 'rho_screw ', 'shear_system'] - character(len=18), dimension(1), parameter, private :: & - plastic_titanmod_listBasicTwinStates = ['gdot_twin'] - character(len=19), dimension(11), parameter, private :: & - plastic_titanmod_listDependentSlipStates = & - ['segment_edge ', 'segment_screw ', & - 'resistance_edge ', 'resistance_screw ', & - 'tau_slip ', & - 'velocity_edge ', 'velocity_screw ', & - 'gdot_slip_edge ', 'gdot_slip_screw ', & - 'stressratio_edge_p ', 'stressratio_screw_p' ] - character(len=18), dimension(2), parameter, private :: & - plastic_titanmod_listDependentTwinStates = & - ['twin_fraction', 'tau_twin '] - real(pReal), parameter, private :: & - kB = 1.38e-23_pReal !< Boltzmann constant in J/Kelvin - - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_titanmod_sizePostResults !< cumulative size of post results - - integer(pInt), dimension(:,:), allocatable, target, public :: & - plastic_titanmod_sizePostResult !< size of each post result output - - character(len=64), dimension(:,:), allocatable, target, public :: & - plastic_titanmod_output !< name of each post result output - - integer(pInt), dimension(:), allocatable, target, public :: & - plastic_titanmod_Noutput !< number of outputs per instance of this plasticity !< ID of the lattice structure - - integer(pInt), dimension(:), allocatable, public, protected :: & - plastic_titanmod_totalNslip, & !< total number of active slip systems for each instance - plastic_titanmod_totalNtwin !< total number of active twin systems for each instance - - integer(pInt), dimension(:,:), allocatable, private :: & - plastic_titanmod_Nslip, & !< number of active slip systems for each family and instance - plastic_titanmod_Ntwin, & !< number of active twin systems for each family and instance - plastic_titanmod_slipFamily, & !< lookup table relating active slip system to slip family for each instance - plastic_titanmod_twinFamily, & !< lookup table relating active twin system to twin family for each instance - plastic_titanmod_slipSystemLattice, & !< lookup table relating active slip system index to lattice slip system index for each instance - plastic_titanmod_twinSystemLattice !< lookup table relating active twin system index to lattice twin system index for each instance - - real(pReal), dimension(:), allocatable, private :: & - plastic_titanmod_debyefrequency, & !< Debye frequency - plastic_titanmod_kinkf0, & !< - plastic_titanmod_CAtomicVolume, & !< atomic volume in Bugers vector unit - plastic_titanmod_dc, & !< prefactor for self-diffusion coefficient - plastic_titanmod_twinhpconstant, & !< activation energy for dislocation climb - plastic_titanmod_GrainSize, & !< grain size - Not being used - plastic_titanmod_MaxTwinFraction, & !< maximum allowed total twin volume fraction - plastic_titanmod_r, & !< r-exponent in twin nucleation rate - plastic_titanmod_CEdgeDipMinDistance, & !< Not being used - plastic_titanmod_Cmfptwin, & !< Not being used - plastic_titanmod_Cthresholdtwin, & !< Not being used - plastic_titanmod_aTolRho !< absolute tolerance for integration of dislocation density - - real(pReal), dimension(:,:), allocatable, private :: & - plastic_titanmod_rho_edge0, & !< initial edge dislocation density per slip system for each family and instance - plastic_titanmod_rho_screw0, & !< initial screw dislocation density per slip system for each family and instance - plastic_titanmod_shear_system0, & !< accumulated shear on each system - plastic_titanmod_burgersPerSlipFam, & !< absolute length of burgers vector [m] for each slip family and instance - plastic_titanmod_burgersPerSlipSys, & !< absolute length of burgers vector [m] for each slip system and instance - plastic_titanmod_burgersPerTwinFam, & !< absolute length of burgers vector [m] for each twin family and instance - plastic_titanmod_burgersPerTwinSys, & !< absolute length of burgers vector [m] for each twin system and instance - plastic_titanmod_f0_PerSlipFam, & !< activation energy for glide [J] for each slip family and instance - plastic_titanmod_f0_PerSlipSys, & !< activation energy for glide [J] for each slip system and instance - plastic_titanmod_twinf0_PerTwinFam, & !< activation energy for glide [J] for each twin family and instance - plastic_titanmod_twinf0_PerTwinSys, & !< activation energy for glide [J] for each twin system and instance - plastic_titanmod_twinshearconstant_PerTwinFam, & !< activation energy for glide [J] for each twin family and instance - plastic_titanmod_twinshearconstant_PerTwinSys, & !< activation energy for glide [J] for each twin system and instance - plastic_titanmod_tau0e_PerSlipFam, & !< Initial yield stress for edge dislocations per slip family - plastic_titanmod_tau0e_PerSlipSys, & !< Initial yield stress for edge dislocations per slip system - plastic_titanmod_tau0s_PerSlipFam, & !< Initial yield stress for screw dislocations per slip family - plastic_titanmod_tau0s_PerSlipSys, & !< Initial yield stress for screw dislocations per slip system - plastic_titanmod_twintau0_PerTwinFam, & !< Initial yield stress for edge dislocations per twin family - plastic_titanmod_twintau0_PerTwinSys, & !< Initial yield stress for edge dislocations per twin system - plastic_titanmod_capre_PerSlipFam, & !< Capture radii for edge dislocations per slip family - plastic_titanmod_capre_PerSlipSys, & !< Capture radii for edge dislocations per slip system - plastic_titanmod_caprs_PerSlipFam, & !< Capture radii for screw dislocations per slip family - plastic_titanmod_caprs_PerSlipSys, & !< Capture radii for screw dislocations per slip system - plastic_titanmod_pe_PerSlipFam, & !< p-exponent in glide velocity - plastic_titanmod_ps_PerSlipFam, & !< p-exponent in glide velocity - plastic_titanmod_qe_PerSlipFam, & !< q-exponent in glide velocity - plastic_titanmod_qs_PerSlipFam, & !< q-exponent in glide velocity - plastic_titanmod_pe_PerSlipSys, & !< p-exponent in glide velocity - plastic_titanmod_ps_PerSlipSys, & !< p-exponent in glide velocity - plastic_titanmod_qe_PerSlipSys, & !< q-exponent in glide velocity - plastic_titanmod_qs_PerSlipSys, & !< q-exponent in glide velocity - plastic_titanmod_twinp_PerTwinFam, & !< p-exponent in glide velocity - plastic_titanmod_twinq_PerTwinFam, & !< q-exponent in glide velocity - plastic_titanmod_twinp_PerTwinSys, & !< p-exponent in glide velocity - plastic_titanmod_twinq_PerTwinSys, & !< p-exponent in glide velocity - plastic_titanmod_v0e_PerSlipFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance - plastic_titanmod_v0e_PerSlipSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance - plastic_titanmod_v0s_PerSlipFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance - plastic_titanmod_v0s_PerSlipSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance - plastic_titanmod_twingamma0_PerTwinFam, & !< edge dislocation velocity prefactor [m/s] for each family and instance - plastic_titanmod_twingamma0_PerTwinSys, & !< screw dislocation velocity prefactor [m/s] for each slip system and instance - plastic_titanmod_kinkcriticallength_PerSlipFam, & !< screw dislocation mobility prefactor for kink-pairs per slip family - plastic_titanmod_kinkcriticallength_PerSlipSys, & !< screw dislocation mobility prefactor for kink-pairs per slip system - plastic_titanmod_twinsizePerTwinFam, & !< twin thickness [m] for each twin family and instance - plastic_titanmod_twinsizePerTwinSys, & !< twin thickness [m] for each twin system and instance - plastic_titanmod_CeLambdaSlipPerSlipFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_titanmod_CeLambdaSlipPerSlipSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_titanmod_CsLambdaSlipPerSlipFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_titanmod_CsLambdaSlipPerSlipSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_titanmod_twinLambdaSlipPerTwinFam, & !< Adj. parameter for distance between 2 forest dislocations for each slip family and instance - plastic_titanmod_twinLambdaSlipPerTwinSys, & !< Adj. parameter for distance between 2 forest dislocations for each slip system and instance - plastic_titanmod_interactionSlipSlip, & !< coefficients for slip-slip interaction for each interaction type and instance - plastic_titanmod_interaction_ee, & !< coefficients for e-e interaction for each interaction type and instance - plastic_titanmod_interaction_ss, & !< coefficients for s-s interaction for each interaction type and instance - plastic_titanmod_interaction_es, & !< coefficients for e-s-twin interaction for each interaction type and instance - plastic_titanmod_interactionSlipTwin, & !< coefficients for twin-slip interaction for each interaction type and instance - plastic_titanmod_interactionTwinSlip, & !< coefficients for twin-slip interaction for each interaction type and instance - plastic_titanmod_interactionTwinTwin !< coefficients for twin-twin interaction for each interaction type and instance - - real(pReal), dimension(:,:,:), allocatable, private :: & - plastic_titanmod_interactionMatrixSlipSlip, & !< interaction matrix of the different slip systems for each instance - plastic_titanmod_interactionMatrix_ee, & !< interaction matrix of e-e for each instance - plastic_titanmod_interactionMatrix_ss, & !< interaction matrix of s-s for each instance - plastic_titanmod_interactionMatrix_es, & !< interaction matrix of e-s for each instance - plastic_titanmod_interactionMatrixSlipTwin, & !< interaction matrix of slip systems with twin systems for each instance - plastic_titanmod_interactionMatrixTwinSlip, & !< interaction matrix of twin systems with slip systems for each instance - plastic_titanmod_interactionMatrixTwinTwin, & !< interaction matrix of the different twin systems for each instance - plastic_titanmod_forestProjectionEdge, & !< matrix of forest projections of edge dislocations for each instance - plastic_titanmod_forestProjectionScrew, & !< matrix of forest projections of screw dislocations for each instance - plastic_titanmod_TwinforestProjectionEdge, & !< matrix of forest projections of edge dislocations in twin system for each instance - plastic_titanmod_TwinforestProjectionScrew !< matrix of forest projections of screw dislocations in twin system for each instance - - real(pReal), dimension(:,:,:,:), allocatable, private :: & - plastic_titanmod_Ctwin66 !< twin elasticity matrix in Mandel notation for each instance - - real(pReal), dimension(:,:,:,:,:,:), allocatable, private :: & - plastic_titanmod_Ctwin3333 !< twin elasticity matrix for each instance - - enum, bind(c) - enumerator :: undefined_ID, & - rhoedge_ID, rhoscrew_ID, & - segment_edge_ID, segment_screw_ID, & - resistance_edge_ID, resistance_screw_ID, & - velocity_edge_ID, velocity_screw_ID, & - tau_slip_ID, & - gdot_slip_edge_ID, gdot_slip_screw_ID, & - gdot_slip_ID, & - stressratio_edge_p_ID, stressratio_screw_p_ID, & - shear_system_ID, & - twin_fraction_ID, & - shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & - rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & - rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & - shear_total_ID - end enum - integer(kind(undefined_ID)), dimension(:,:), allocatable, private :: & - plastic_titanmod_outputID !< ID of each post result output - - public :: & - plastic_titanmod_microstructure, & - plastic_titanmod_stateInit, & - plastic_titanmod_init, & - plastic_titanmod_LpAndItsTangent, & - plastic_titanmod_dotState, & - plastic_titanmod_postResults, & - plastic_titanmod_homogenizedC - - contains - -!-------------------------------------------------------------------------------------------------- -!> @brief module initialization -!> @details reads in material parameters, allocates arrays, and does sanity checks -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_init(fileUnit) -#ifdef __GFORTRAN__ - use, intrinsic :: iso_fortran_env, only: & - compiler_version, & - compiler_options -#endif - use debug, only: & - debug_level,& - debug_constitutive,& - debug_levelBasic - use math, only: & - math_Mandel3333to66,& - math_Voigt66to3333,& - math_mul3x3 - 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 - use material, only: & - phase_plasticity, & - phase_plasticityInstance, & - phase_Noutput, & - PLASTICITY_TITANMOD_label, & - PLASTICITY_TITANMOD_ID, & - plasticState, & - MATERIAL_partPhase - use lattice - use numerics,only: & - numerics_integrator - - implicit none - integer(pInt), intent(in) :: fileUnit - - integer(pInt), allocatable, dimension(:) :: chunkPos - integer(pInt) :: & - phase, & - instance, j, k, l, m, n, p, q, r, & - f, o, & - s, s1, s2, & - t, t1, t2, & - ns, nt, & - Nchunks_SlipSlip = 0_pInt, Nchunks_SlipTwin = 0_pInt, Nchunks_TwinSlip = 0_pInt, Nchunks_TwinTwin = 0_pInt, & - Nchunks_SlipFamilies = 0_pInt, Nchunks_TwinFamilies = 0_pInt, & - offset_slip, mySize, & - maxTotalNslip,maxTotalNtwin, maxNinstance - integer(pInt) :: sizeState, sizeDotState, sizeDeltaState - integer(pInt) :: NofMyPhase = 0_pInt - character(len=65536) :: & - tag = '', & - line = '' - - write(6,'(/,a)') ' <<<+- constitutive_'//PLASTICITY_TITANMOD_label//' init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() -#include "compilation_info.f90" - - maxNinstance = int(count(phase_plasticity == PLASTICITY_TITANMOD_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_titanmod_sizePostResults(maxNinstance), source=0_pInt) - allocate(plastic_titanmod_sizePostResult(maxval(phase_Noutput),maxNinstance), source=0_pInt) - allocate(plastic_titanmod_output(maxval(phase_Noutput),maxNinstance)) - plastic_titanmod_output = '' - allocate(plastic_titanmod_outputID(maxval(phase_Noutput),maxNinstance), source=undefined_ID) - allocate(plastic_titanmod_Noutput(maxNinstance), source=0_pInt) - - allocate(plastic_titanmod_Nslip(lattice_maxNslipFamily,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_Ntwin(lattice_maxNtwinFamily,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_slipFamily(lattice_maxNslip,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_twinFamily(lattice_maxNtwin,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_slipSystemLattice(lattice_maxNslip,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_twinSystemLattice(lattice_maxNtwin,maxNinstance), source=0_pInt) - allocate(plastic_titanmod_totalNslip(maxNinstance), source=0_pInt) - allocate(plastic_titanmod_totalNtwin(maxNinstance), source=0_pInt) - allocate(plastic_titanmod_debyefrequency(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_kinkf0(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CAtomicVolume(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_dc(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinhpconstant(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_GrainSize(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_MaxTwinFraction(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_r(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CEdgeDipMinDistance(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Cmfptwin(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Cthresholdtwin(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_aTolRho(maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_rho_edge0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_rho_screw0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_shear_system0(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_burgersPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_burgersPerTwinFam(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_f0_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0e_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0s_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_capre_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_caprs_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_pe_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_ps_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qe_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qs_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0e_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0s_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_kinkcriticallength_PerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinsizePerTwinFam(lattice_maxNtwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CeLambdaSlipPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CsLambdaSlipPerSlipFam(lattice_maxNslipFamily,maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_twinf0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinshearconstant_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twintau0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinp_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinq_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twingamma0_PerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinLambdaSlipPerTwinFam(lattice_maxNTwinFamily,maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_interactionSlipSlip(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interaction_ee(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interaction_ss(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interaction_es(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionSlipTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionTwinSlip(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionTwinTwin(lattice_maxNinteraction,maxNinstance), source=0.0_pReal) - - 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 section - phase = phase + 1_pInt ! advance section counter - if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then - Nchunks_SlipFamilies = count(lattice_NslipSystem(:,phase) > 0_pInt) - Nchunks_TwinFamilies = count(lattice_NtwinSystem(:,phase) > 0_pInt) - Nchunks_SlipSlip = maxval(lattice_interactionSlipSlip(:,:,phase)) - Nchunks_SlipTwin = maxval(lattice_interactionSlipTwin(:,:,phase)) - Nchunks_TwinSlip = maxval(lattice_interactionTwinSlip(:,:,phase)) - Nchunks_TwinTwin = maxval(lattice_interactionTwinTwin(:,:,phase)) - endif - cycle ! skip to next line - endif - if (phase > 0_pInt ) then; if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then ! one of my sections. 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 ('rhoedge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('segment_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('segment_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = segment_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('resistance_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = resistance_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('velocity_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = velocity_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('tau_slip') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = tau_slip_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('gdot_slip_edge') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_edge_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('gdot_slip_screw') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_screw_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('gdot_slip') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = gdot_slip_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('stressratio_edge_p') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_edge_p_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('stressratio_screw_p') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = stressratio_screw_p_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_system') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_system_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('twin_fraction') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = twin_fraction_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_basal') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_basal_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_prism') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_prism_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_pyra') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyra_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_pyrca') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_pyrca_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_basal') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_basal_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_prism') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_prism_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_pyra') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyra_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoedge_pyrca') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoedge_pyrca_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_basal') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_basal_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_prism') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_prism_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_pyra') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyra_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('rhoscrew_pyrca') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = rhoscrew_pyrca_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - case ('shear_total') - plastic_titanmod_Noutput(instance) = plastic_titanmod_Noutput(instance) + 1_pInt - plastic_titanmod_outputID(plastic_titanmod_Noutput(instance),instance) = shear_total_ID - plastic_titanmod_output(plastic_titanmod_Noutput(instance),instance) = & - IO_lc(IO_stringValue(line,chunkPos,2_pInt)) - end select - case ('debyefrequency') - plastic_titanmod_debyefrequency(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('kinkf0') - plastic_titanmod_kinkf0(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('nslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipFamilies) & - call IO_warning(50_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_Nslip(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('ntwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinFamilies) & - call IO_warning(51_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_Ntwin(j,instance) = IO_intValue(line,chunkPos,1_pInt+j) - enddo - case ('rho_edge0') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_rho_edge0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('rho_screw0') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_rho_screw0(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('slipburgers') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_burgersPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinburgers') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_burgersPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('f0') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_f0_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinf0') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinf0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0e') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_tau0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twintau0') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twintau0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('tau0s') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_tau0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('capre') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_capre_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('caprs') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_caprs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('v0e') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_v0e_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twingamma0') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twingamma0_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('v0s') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_v0s_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('kinkcriticallength') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_kinkcriticallength_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinsize') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinsizePerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('celambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_CeLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinlambdaslip') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinlambdaslipPerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('cslambdaslip') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_CsLambdaSlipPerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('grainsize') - plastic_titanmod_GrainSize(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('maxtwinfraction') - plastic_titanmod_MaxTwinFraction(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('pe') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_pe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinp') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinp_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('ps') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_ps_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('qe') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_qe_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinq') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinq_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('qs') - do j = 1_pInt, Nchunks_SlipFamilies - plastic_titanmod_qs_PerSlipFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('twinshearconstant') - do j = 1_pInt, Nchunks_TwinFamilies - plastic_titanmod_twinshearconstant_PerTwinFam(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('dc') - plastic_titanmod_dc(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('twinhpconstant') - plastic_titanmod_twinhpconstant(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('atol_rho') - plastic_titanmod_aTolRho(instance) = IO_floatValue(line,chunkPos,2_pInt) - case ('interactionee') - do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_ee(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interactionss') - do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_ss(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interactiones') - do j = 1_pInt, lattice_maxNinteraction - plastic_titanmod_interaction_es(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_slipslip','interactionslipslip') - if (chunkPos(1) < 1_pInt + Nchunks_SlipSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipSlip - plastic_titanmod_interactionSlipSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_sliptwin','interactionsliptwin') - if (chunkPos(1) < 1_pInt + Nchunks_SlipTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_SlipTwin - plastic_titanmod_interactionSlipTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twinslip','interactiontwinslip') - if (chunkPos(1) < 1_pInt + Nchunks_TwinSlip) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinSlip - plastic_titanmod_interactionTwinSlip(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - case ('interaction_twintwin','interactiontwintwin') - if (chunkPos(1) < 1_pInt + Nchunks_TwinTwin) & - call IO_warning(52_pInt,ext_msg=trim(tag)//' ('//PLASTICITY_TITANMOD_label//')') - do j = 1_pInt, Nchunks_TwinTwin - plastic_titanmod_interactionTwinTwin(j,instance) = IO_floatValue(line,chunkPos,1_pInt+j) - enddo - end select - endif; endif - enddo parsingFile - - sanityChecks: do phase = 1_pInt, size(phase_plasticity) - myPhase: if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then - instance = phase_plasticityInstance(phase) - if (sum(plastic_titanmod_Nslip(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='nslip ('//PLASTICITY_TITANMOD_label//')') - if (sum(plastic_titanmod_Ntwin(:,instance)) < 0_pInt) & - call IO_error(211_pInt,el=instance,ext_msg='ntwin ('//PLASTICITY_TITANMOD_label//')') - do f = 1_pInt,lattice_maxNslipFamily - if (plastic_titanmod_Nslip(f,instance) > 0_pInt) then - if (plastic_titanmod_rho_edge0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rho_edge0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_rho_screw0(f,instance) < 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='rho_screw0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_burgersPerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='slipburgers ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_f0_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='f0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_tau0e_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau0e ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_tau0s_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='tau0s ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_capre_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='capre ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_caprs_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='caprs ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_v0e_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0e ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_v0s_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='v0s ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_kinkcriticallength_PerSlipFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='kinkCriticalLength ('//PLASTICITY_TITANMOD_label//')') - endif - enddo - do f = 1_pInt,lattice_maxNtwinFamily - if (plastic_titanmod_Ntwin(f,instance) > 0_pInt) then - if (plastic_titanmod_burgersPerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinburgers ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twinf0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinf0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twinshearconstant_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinshearconstant ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twintau0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twintau0 ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twingamma0_PerTwinFam(f,instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twingamma0 ('//PLASTICITY_TITANMOD_label//')') - endif - enddo - if (plastic_titanmod_dc(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='dc ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_twinhpconstant(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='twinhpconstant ('//PLASTICITY_TITANMOD_label//')') - if (plastic_titanmod_aTolRho(instance) <= 0.0_pReal) & - call IO_error(211_pInt,el=instance,ext_msg='aTol_rho ('//PLASTICITY_TITANMOD_label//')') - -!-------------------------------------------------------------------------------------------------- -! determine total number of active slip or twin systems - plastic_titanmod_Nslip(:,instance) = min(lattice_NslipSystem(:,phase),plastic_titanmod_Nslip(:,instance)) - plastic_titanmod_Ntwin(:,instance) = min(lattice_NtwinSystem(:,phase),plastic_titanmod_Ntwin(:,instance)) - plastic_titanmod_totalNslip(instance) = sum(plastic_titanmod_Nslip(:,instance)) - plastic_titanmod_totalNtwin(instance) = sum(plastic_titanmod_Ntwin(:,instance)) - endif myPhase - enddo sanityChecks - -!-------------------------------------------------------------------------------------------------- -! allocation of variables whose size depends on the total number of active slip systems - maxTotalNslip = maxval(plastic_titanmod_totalNslip) - maxTotalNtwin = maxval(plastic_titanmod_totalNtwin) - - allocate(plastic_titanmod_burgersPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_f0_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0e_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_tau0s_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_capre_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_caprs_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_pe_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_ps_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qe_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_qs_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0e_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_v0s_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_kinkcriticallength_PerSlipSys(maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CeLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_CsLambdaSlipPerSlipSys(maxTotalNslip, maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_burgersPerTwinSys(maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinf0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinshearconstant_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twintau0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinp_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinq_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twingamma0_PerTwinSys(maxTotalNTwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinsizePerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_twinLambdaSlipPerTwinSys(maxTotalNtwin, maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Ctwin66 (6,6,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_Ctwin3333 (3,3,3,3,maxTotalNtwin,maxNinstance), source=0.0_pReal) - - allocate(plastic_titanmod_interactionMatrixSlipSlip(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrix_ee(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrix_ss(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrix_es(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrixSlipTwin(maxTotalNslip,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrixTwinSlip(maxTotalNtwin,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_interactionMatrixTwinTwin(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_forestProjectionEdge(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_forestProjectionScrew(maxTotalNslip,maxTotalNslip,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_TwinforestProjectionEdge(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - allocate(plastic_titanmod_TwinforestProjectionScrew(maxTotalNtwin,maxTotalNtwin,maxNinstance), source=0.0_pReal) - - initializeInstances: do phase = 1_pInt, size(phase_plasticity) - if (phase_plasticity(phase) == PLASTICITY_TITANMOD_ID) then - instance = phase_plasticityInstance(phase) - -!-------------------------------------------------------------------------------------------------- -! inverse lookup of slip system family - l = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - do s = 1_pInt,plastic_titanmod_Nslip(f,instance) - l = l + 1_pInt - plastic_titanmod_slipFamily(l,instance) = f - plastic_titanmod_slipSystemLattice(l,instance) = sum(lattice_NslipSystem(1:f-1_pInt,phase)) + s - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! inverse lookup of twin system family - l = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily - do t = 1_pInt,plastic_titanmod_Ntwin(f,instance) - l = l + 1_pInt - plastic_titanmod_twinFamily(l,instance) = f - plastic_titanmod_twinSystemLattice(l,instance) = sum(lattice_NtwinSystem(1:f-1_pInt,phase)) + t - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! determine size of state array - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - sizeDotState = & - size(plastic_titanmod_listBasicSlipStates)*ns + & - size(plastic_titanmod_listBasicTwinStates)*nt - sizeState = sizeDotState+ & - size(plastic_titanmod_listDependentSlipStates)*ns + & - size(plastic_titanmod_listDependentTwinStates)*nt - sizeDeltaState = 0_pInt - -!-------------------------------------------------------------------------------------------------- -! determine size of postResults array - outputsLoop: do o = 1_pInt,plastic_titanmod_Noutput(instance) - mySize = 0_pInt - select case(plastic_titanmod_outputID(o,instance)) - case(rhoedge_ID, rhoscrew_ID, & - segment_edge_ID, segment_screw_ID, & - resistance_edge_ID, resistance_screw_ID, & - velocity_edge_ID, velocity_screw_ID, & - tau_slip_ID, & - gdot_slip_edge_ID, gdot_slip_screw_ID, & - gdot_slip_ID, & - stressratio_edge_p_ID, stressratio_screw_p_ID, & - shear_system_ID) - mySize = plastic_titanmod_totalNslip(instance) - case(twin_fraction_ID) - mySize = plastic_titanmod_totalNtwin(instance) - case(shear_basal_ID, shear_prism_ID, shear_pyra_ID, shear_pyrca_ID, & ! use only if all 4 slip families in hex are considered - rhoedge_basal_ID, rhoedge_prism_ID, rhoedge_pyra_ID, rhoedge_pyrca_ID, & - rhoscrew_basal_ID, rhoscrew_prism_ID, rhoscrew_pyra_ID, rhoscrew_pyrca_ID, & - shear_total_ID) - mySize = 1_pInt - case default - call IO_error(105_pInt,ext_msg=plastic_titanmod_output(o,instance)// & - ' ('//PLASTICITY_TITANMOD_label//')') - end select - - outputFound: if (mySize > 0_pInt) then - plastic_titanmod_sizePostResult(o,instance) = mySize - plastic_titanmod_sizePostResults(instance) = plastic_titanmod_sizePostResults(instance) + mySize - endif outputFound - enddo outputsLoop -! Determine size of state array - plasticState(phase)%sizeState = sizeState - plasticState(phase)%sizeDotState = sizeDotState - plasticState(phase)%sizeDeltaState = sizeDeltaState - plasticState(phase)%sizePostResults = plastic_titanmod_sizePostResults(instance) - plasticState(phase)%nSlip =plastic_titanmod_totalNslip(instance) - plasticState(phase)%nTwin = 0_pInt - plasticState(phase)%nTrans= 0_pInt - allocate(plasticState(phase)%aTolState (sizeState), source=plastic_titanmod_aTolRho(instance)) - allocate(plasticState(phase)%state0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%partionedState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%subState0 (sizeState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%state (sizeState,NofMyPhase), source=0.0_pReal) - - allocate(plasticState(phase)%dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%deltaState (sizeDeltaState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 1_pInt)) then - allocate(plasticState(phase)%previousDotState (sizeDotState,NofMyPhase), source=0.0_pReal) - allocate(plasticState(phase)%previousDotState2 (sizeDotState,NofMyPhase), source=0.0_pReal) - endif - if (any(numerics_integrator == 4_pInt)) & - allocate(plasticState(phase)%RK4dotState (sizeDotState,NofMyPhase), source=0.0_pReal) - if (any(numerics_integrator == 5_pInt)) & - allocate(plasticState(phase)%RKCK45dotState (6,sizeDotState,NofMyPhase),source=0.0_pReal) - offset_slip = 2_pInt*plasticState(phase)%nSlip+1 - plasticState(phase)%slipRate => & - plasticState(phase)%dotState(offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) - plasticState(phase)%accumulatedSlip => & - plasticState(phase)%state (offset_slip+1:offset_slip+plasticState(phase)%nSlip,1:NofMyPhase) -!-------------------------------------------------------------------------------------------------- -! construction of the twin elasticity matrices - do j=1_pInt,lattice_maxNtwinFamily - do k=1_pInt,plastic_titanmod_Ntwin(j,instance) - do l=1_pInt,3_pInt ; do m=1_pInt,3_pInt ; do n=1_pInt,3_pInt ; do o=1_pInt,3_pInt - do p=1_pInt,3_pInt ; do q=1_pInt,3_pInt ; do r=1_pInt,3_pInt ; do s=1_pInt,3_pInt - plastic_titanmod_Ctwin3333(l,m,n,o,sum(plastic_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) = & - plastic_titanmod_Ctwin3333(l,m,n,o,sum(plastic_titanmod_Nslip(1:j-1_pInt,instance))+k,instance) + & - lattice_C3333(p,q,r,s,phase)*& - lattice_Qtwin(l,p,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & - lattice_Qtwin(m,q,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & - lattice_Qtwin(n,r,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase)* & - lattice_Qtwin(o,s,sum(lattice_NslipSystem(1:j-1_pInt,phase))+k,phase) - enddo; enddo; enddo; enddo - enddo; enddo; enddo ; enddo - plastic_titanmod_Ctwin66(1:6,1:6,k,instance) = & - math_Mandel3333to66(plastic_titanmod_Ctwin3333(1:3,1:3,1:3,1:3,k,instance)) - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! Burgers vector, dislocation velocity prefactor for each slip system - do s = 1_pInt,plastic_titanmod_totalNslip(instance) - f = plastic_titanmod_slipFamily(s,instance) - - plastic_titanmod_burgersPerSlipSys(s,instance) = & - plastic_titanmod_burgersPerSlipFam(f,instance) - - plastic_titanmod_f0_PerSlipSys(s,instance) = & - plastic_titanmod_f0_PerSlipFam(f,instance) - - plastic_titanmod_tau0e_PerSlipSys(s,instance) = & - plastic_titanmod_tau0e_PerSlipFam(f,instance) - - plastic_titanmod_tau0s_PerSlipSys(s,instance) = & - plastic_titanmod_tau0s_PerSlipFam(f,instance) - - plastic_titanmod_capre_PerSlipSys(s,instance) = & - plastic_titanmod_capre_PerSlipFam(f,instance) - - plastic_titanmod_caprs_PerSlipSys(s,instance) = & - plastic_titanmod_caprs_PerSlipFam(f,instance) - - plastic_titanmod_v0e_PerSlipSys(s,instance) = & - plastic_titanmod_v0e_PerSlipFam(f,instance) - - plastic_titanmod_v0s_PerSlipSys(s,instance) = & - plastic_titanmod_v0s_PerSlipFam(f,instance) - - plastic_titanmod_kinkcriticallength_PerSlipSys(s,instance) = & - plastic_titanmod_kinkcriticallength_PerSlipFam(f,instance) - - plastic_titanmod_pe_PerSlipSys(s,instance) = & - plastic_titanmod_pe_PerSlipFam(f,instance) - - plastic_titanmod_ps_PerSlipSys(s,instance) = & - plastic_titanmod_ps_PerSlipFam(f,instance) - - plastic_titanmod_qe_PerSlipSys(s,instance) = & - plastic_titanmod_qe_PerSlipFam(f,instance) - - plastic_titanmod_qs_PerSlipSys(s,instance) = & - plastic_titanmod_qs_PerSlipFam(f,instance) - - plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance) = & - plastic_titanmod_CeLambdaSlipPerSlipFam(f,instance) - - plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance) = & - plastic_titanmod_CsLambdaSlipPerSlipFam(f,instance) - enddo - -!-------------------------------------------------------------------------------------------------- -! Burgers vector, nucleation rate prefactor and twin size for each twin system - do t = 1_pInt,plastic_titanmod_totalNtwin(instance) - f = plastic_titanmod_twinFamily(t,instance) - - plastic_titanmod_burgersPerTwinSys(t,instance) = & - plastic_titanmod_burgersPerTwinFam(f,instance) - - plastic_titanmod_twinsizePerTwinSys(t,instance) = & - plastic_titanmod_twinsizePerTwinFam(f,instance) - - plastic_titanmod_twinf0_PerTwinSys(t,instance) = & - plastic_titanmod_twinf0_PerTwinFam(f,instance) - - plastic_titanmod_twinshearconstant_PerTwinSys(t,instance) = & - plastic_titanmod_twinshearconstant_PerTwinFam(f,instance) - - plastic_titanmod_twintau0_PerTwinSys(t,instance) = & - plastic_titanmod_twintau0_PerTwinFam(f,instance) - - plastic_titanmod_twingamma0_PerTwinSys(t,instance) = & - plastic_titanmod_twingamma0_PerTwinFam(f,instance) - - plastic_titanmod_twinp_PerTwinSys(t,instance) = & - plastic_titanmod_twinp_PerTwinFam(f,instance) - - plastic_titanmod_twinq_PerTwinSys(t,instance) = & - plastic_titanmod_twinq_PerTwinFam(f,instance) - - plastic_titanmod_twinLambdaSlipPerTwinSys(t,instance) = & - plastic_titanmod_twinLambdaSlipPerTwinFam(f,instance) - enddo - -!-------------------------------------------------------------------------------------------------- -! Construction of interaction matrices - do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) - do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) - plastic_titanmod_interactionMatrixSlipSlip(s1,s2,instance) = & - plastic_titanmod_interactionSlipSlip(lattice_interactionSlipSlip( & - plastic_titanmod_slipSystemLattice(s1,instance),& - plastic_titanmod_slipSystemLattice(s2,instance),phase),instance) - - plastic_titanmod_interactionMatrix_ee(s1,s2,instance) = & - plastic_titanmod_interaction_ee(lattice_interactionSlipSlip ( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - - plastic_titanmod_interactionMatrix_ss(s1,s2,instance) = & - plastic_titanmod_interaction_ss(lattice_interactionSlipSlip( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - - plastic_titanmod_interactionMatrix_es(s1,s2,instance) = & - plastic_titanmod_interaction_es(lattice_interactionSlipSlip( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - enddo; enddo - - do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) - do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) - plastic_titanmod_interactionMatrixSlipTwin(s1,t2,instance) = & - plastic_titanmod_interactionSlipTwin(lattice_interactionSlipTwin( & - plastic_titanmod_slipSystemLattice(s1,instance), & - plastic_titanmod_twinSystemLattice(t2,instance), phase),instance) - enddo; enddo - - do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) - do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) - plastic_titanmod_interactionMatrixTwinSlip(t1,s2,instance) = & - plastic_titanmod_interactionTwinSlip(lattice_interactionTwinSlip( & - plastic_titanmod_twinSystemLattice(t1,instance), & - plastic_titanmod_slipSystemLattice(s2,instance), phase),instance) - enddo; enddo - - do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) - do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) - plastic_titanmod_interactionMatrixTwinTwin(t1,t2,instance) = & - plastic_titanmod_interactionTwinTwin(lattice_interactionTwinTwin( & - plastic_titanmod_twinSystemLattice(t1,instance), & - plastic_titanmod_twinSystemLattice(t2,instance), phase),instance) - enddo; enddo - - do s1 = 1_pInt,plastic_titanmod_totalNslip(instance) - do s2 = 1_pInt,plastic_titanmod_totalNslip(instance) -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for edge dislocations - plastic_titanmod_forestProjectionEdge(s1,s2,instance) = & - abs(math_mul3x3(lattice_sn(:,plastic_titanmod_slipSystemLattice(s1,instance),phase), & - lattice_st(:,plastic_titanmod_slipSystemLattice(s2,instance),phase))) - -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for screw dislocations - plastic_titanmod_forestProjectionScrew(s1,s2,instance) = & - abs(math_mul3x3(lattice_sn(:,plastic_titanmod_slipSystemLattice(s1,instance),phase), & - lattice_sd(:,plastic_titanmod_slipSystemLattice(s2,instance),phase))) - enddo; enddo - -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for edge dislocations in twin system - do t1 = 1_pInt,plastic_titanmod_totalNtwin(instance) - do t2 = 1_pInt,plastic_titanmod_totalNtwin(instance) - plastic_titanmod_TwinforestProjectionEdge(t1,t2,instance) = & - abs(math_mul3x3(lattice_tn(:,plastic_titanmod_twinSystemLattice(t1,instance),phase), & - lattice_tt(:,plastic_titanmod_twinSystemLattice(t2,instance),phase))) - -!-------------------------------------------------------------------------------------------------- -! calculation of forest projections for screw dislocations in twin system - plastic_titanmod_TwinforestProjectionScrew(t1,t2,instance) = & - abs(math_mul3x3(lattice_tn(:,plastic_titanmod_twinSystemLattice(t1,instance),phase), & - lattice_td(:,plastic_titanmod_twinSystemLattice(t2,instance),phase))) - enddo; enddo - call plastic_titanmod_stateInit(phase,instance) - endif - enddo initializeInstances - -end subroutine plastic_titanmod_init - - -!-------------------------------------------------------------------------------------------------- -!> @brief sets the initial microstructural state for a given instance of this plasticity -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_stateInit(ph,instance) - use lattice, only: & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_mu - - use material, only: & - plasticState - - implicit none - integer(pInt), intent(in) :: instance !< number specifying the instance of the plasticity - integer(pInt), intent(in) :: ph !< number specifying the phase of the plasticity - - - integer(pInt) :: & - s,s0,s1, & - t,t0,t1, & - ns,nt,f - real(pReal), dimension(plastic_titanmod_totalNslip(instance)) :: & - rho_edge0, & - rho_screw0, & - shear_system0, & - segment_edge0, & - segment_screw0, & - resistance_edge0, & - resistance_screw0 - real(pReal), dimension(plastic_titanmod_totalNtwin(instance)) :: & - twingamma_dot0, & - resistance_twin0 - real(pReal), dimension(plasticState(ph)%sizeState) :: tempState !!!!!!!!!????????? check - - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - tempState = 0.0_pReal -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables for slip - s1 = 0_pInt - do f = 1_pInt,lattice_maxNslipFamily - s0 = s1 + 1_pInt - s1 = s0 + plastic_titanmod_Nslip(f,instance) - 1_pInt - do s = s0,s1 - rho_edge0(s) = plastic_titanmod_rho_edge0(f,instance) - rho_screw0(s) = plastic_titanmod_rho_screw0(f,instance) - shear_system0(s) = 0.0_pReal - enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! initialize basic slip state variables for twin - t1 = 0_pInt - do f = 1_pInt,lattice_maxNtwinFamily - t0 = t1 + 1_pInt - t1 = t0 + plastic_titanmod_Ntwin(f,instance) - 1_pInt - do t = t0,t1 - twingamma_dot0(t)=0.0_pReal - enddo - enddo - -!-------------------------------------------------------------------------------------------------- -! initialize dependent slip microstructural variables - forall (s = 1_pInt:ns) - segment_edge0(s) = plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product((rho_edge0),plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product((rho_screw0),plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) - segment_screw0(s) = plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product((rho_edge0),plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product((rho_screw0),plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) - resistance_edge0(s) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)* & - sqrt(dot_product((rho_edge0),plastic_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & - dot_product((rho_screw0),plastic_titanmod_interactionMatrix_es(1:ns,s,instance))) - resistance_screw0(s) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)* & - sqrt(dot_product((rho_edge0),plastic_titanmod_interactionMatrix_es(1:ns,s,instance))+ & - dot_product((rho_screw0), plastic_titanmod_interactionMatrix_ss(1:ns,s,instance))) - end forall - - forall (t = 1_pInt:nt) & - resistance_twin0(t) = 0.0_pReal - -tempState = 0.0_pReal -tempState (1:ns) = rho_edge0 -tempState (1_pInt*ns+1_pInt:2_pInt*ns) = rho_screw0 -tempState (2_pInt*ns+1_pInt:3_pInt*ns) = shear_system0 -tempState (3_pInt*ns+1_pInt:3_pInt*ns+nt) = twingamma_dot0 -tempState (3_pInt*ns+nt+1_pInt:4_pInt*ns+nt) = segment_edge0 -tempState (4_pInt*ns+nt+1_pInt:5_pInt*ns+nt) = segment_screw0 -tempState (5_pInt*ns+nt+1_pInt:6_pInt*ns+nt) = resistance_edge0 -tempState (6_pInt*ns+nt+1_pInt:7_pInt*ns+nt) = resistance_screw0 -tempState (7_pInt*ns+nt+1_pInt:7_pInt*ns+2_pInt*nt)=resistance_twin0 - -plasticState(ph)%state0 = spread(tempState,2,size(plasticState(ph)%state(1,:))) -end subroutine plastic_titanmod_stateInit - -!-------------------------------------------------------------------------------------------------- -!> @brief returns the homogenized elasticity matrix -!-------------------------------------------------------------------------------------------------- -function plastic_titanmod_homogenizedC(ipc,ip,el) - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - use lattice, only: & - lattice_C66 - -implicit none - real(pReal), dimension(6,6) :: & - plastic_titanmod_homogenizedC - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element -real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - volumefraction_PerTwinSys - integer(pInt) :: & - ph, & - of, & - instance, & - ns, nt, & - i - real(pReal) :: & - sumf - -!-------------------------------------------------------------------------------------------------- -! shortened notation -! ph = material_phase(ipc,ip,el) - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - -!-------------------------------------------------------------------------------------------------- -! total twin volume fraction - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - enddo - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - -!-------------------------------------------------------------------------------------------------- -! homogenized elasticity matrix - plastic_titanmod_homogenizedC = (1.0_pReal-sumf)*lattice_C66(1:6,1:6,ph) - do i=1_pInt,nt - plastic_titanmod_homogenizedC = plastic_titanmod_homogenizedC & - + volumefraction_PerTwinSys(i)*& - plastic_titanmod_Ctwin66(1:6,1:6,i,instance) - enddo - -end function plastic_titanmod_homogenizedC - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates derived quantities from state -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_microstructure(temperature,ipc,ip,el) - - use material, only: & - material_phase,& - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - use lattice, only: & - lattice_mu - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), intent(in) :: & - temperature !< temperature at IP - integer(pInt) :: & - instance, & - ns, nt, s, t, & - i, & - ph, & - of - real(pReal) :: & - sumf, & - sfe ! stacking fault energy - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - volumefraction_PerTwinSys - -!-------------------------------------------------------------------------------------------------- - -!Shortened notation - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - -!-------------------------------------------------------------------------------------------------- -! total twin volume fraction - forall (i = 1_pInt:nt) & - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - - sfe = 0.0002_pReal*Temperature-0.0396_pReal - -!-------------------------------------------------------------------------------------------------- -! average segment length for edge dislocations in matrix - forall (s = 1_pInt:ns) & - plasticState(ph)%state(3_pInt*ns+nt+s, of) = plastic_titanmod_CeLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product(plasticState(ph)%state(1:ns, of), & - plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & - plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! average segment length for screw dislocations in matrix - forall (s = 1_pInt:ns) & - plasticState(ph)%state(4_pInt*ns+nt+s, of) = plastic_titanmod_CsLambdaSlipPerSlipSys(s,instance)/ & - sqrt(dot_product(plasticState(ph)%state(1:ns, of), & - plastic_titanmod_forestProjectionEdge(1:ns,s,instance))+ & - dot_product(plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of), & - plastic_titanmod_forestProjectionScrew(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! threshold stress or slip resistance for edge dislocation motion - forall (s = 1_pInt:ns) & - plasticState(ph)%state(5_pInt*ns+nt+s, of) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)*& - sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& - plastic_titanmod_interactionMatrix_ee(1:ns,s,instance))+ & - dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& - plastic_titanmod_interactionMatrix_es(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! threshold stress or slip resistance for screw dislocation motion - forall (s = 1_pInt:ns) & - plasticState(ph)%state(6_pInt*ns+nt+s, of) = & - lattice_mu(ph)*plastic_titanmod_burgersPerSlipSys(s,instance)*& - sqrt(dot_product((plasticState(ph)%state(1:ns, of)),& - plastic_titanmod_interactionMatrix_es(1:ns,s,instance))+ & - dot_product((plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of)),& - plastic_titanmod_interactionMatrix_ss(1:ns,s,instance))) -!-------------------------------------------------------------------------------------------------- -! threshold stress or slip resistance for dislocation motion in twin - forall (t = 1_pInt:nt) & - plasticState(ph)%state(7_pInt*ns+nt+t, of) = & - lattice_mu(ph)*plastic_titanmod_burgersPerTwinSys(t,instance)*& - (dot_product((abs(plasticState(ph)%state(2_pInt*ns+1_pInt:2_pInt*ns+nt, of))),& - plastic_titanmod_interactionMatrixTwinTwin(1:nt,t,instance))) - -! state=tempState - -end subroutine plastic_titanmod_microstructure - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates plastic velocity gradient and its tangent -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_LpAndItsTangent(Lp,dLp_dTstar99,Tstar_v,temperature,ipc,ip,el) - use math, only: & - math_Plain3333to99, & - math_Mandel6to33 - use lattice, only: & - lattice_Sslip, & - lattice_Sslip_v, & - lattice_Stwin, & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem, & - lattice_structure, & - LATTICE_hex_ID - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - - implicit none - real(pReal), dimension(3,3), intent(out) :: & - Lp !< plastic velocity gradient - real(pReal), dimension(9,9), intent(out) :: & - dLp_dTstar99 !< derivative of Lp with respect to 2nd Piola Kirchhoff stress - - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(6), intent(in) :: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at IP - integer(pInt) :: & - index_myFamily, instance, & - ns,nt, & - f,i,j,k,l,m,n, & - ph, & - of - real(pReal) :: sumf, & - StressRatio_edge_p, minusStressRatio_edge_p, StressRatio_edge_pminus1, BoltzmannRatioedge, & - StressRatio_screw_p, minusStressRatio_screw_p, StressRatio_screw_pminus1, BoltzmannRatioscrew, & - twinStressRatio_p, twinminusStressRatio_p, twinStressRatio_pminus1, BoltzmannRatiotwin, & - twinDotGamma0, bottomstress_edge, bottomstress_screw, screwvelocity_prefactor - real(pReal), dimension(3,3,3,3) :: dLp_dTstar3333 - real(pReal), dimension(plastic_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_slip,dgdot_dtauslip,tau_slip, & - edge_velocity, screw_velocity, & - gdot_slip_edge, gdot_slip_screw - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin,dgdot_dtautwin,tau_twin, volumefraction_PerTwinSys - -! tempState=state - - - -!-------------------------------------------------------------------------------------------------- -! shortened notation - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - - enddo - - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - - - Lp = 0.0_pReal - dLp_dTstar3333 = 0.0_pReal - dLp_dTstar99 = 0.0_pReal - - !* Dislocation glide part - gdot_slip = 0.0_pReal - gdot_slip_edge = 0.0_pReal - gdot_slip_screw = 0.0_pReal - dgdot_dtauslip = 0.0_pReal - j = 0_pInt - slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Nslip(f,instance) ! process each (active) slip system in family - j = j+1_pInt - - !* Calculation of Lp - !* Resolved shear stress on slip system - tau_slip(j) = dot_product(Tstar_v,lattice_Sslip_v(:,1,index_myFamily+i,ph)) - if(lattice_structure(ph)==LATTICE_hex_ID) then ! only for prismatic and pyr systems in hex - screwvelocity_prefactor=plastic_titanmod_debyefrequency(instance)* & - plasticState(ph)%state(4_pInt*ns+nt+j, of)*(plastic_titanmod_burgersPerSlipSys(j,instance)/ & - plastic_titanmod_kinkcriticallength_PerSlipSys(j,instance))**2 - - !* Stress ratio for screw ! No slip resistance for screw dislocations, only Peierls stress - bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance) - StressRatio_screw_p = ((abs(tau_slip(j)))/ & - ( bottomstress_screw) & - )**plastic_titanmod_ps_PerSlipSys(j,instance) - - if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then - minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p - else - minusStressRatio_screw_p=0.001_pReal - endif - - bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance) - StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/ & - ( bottomstress_screw) & - )**(plastic_titanmod_ps_PerSlipSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio for screw - BoltzmannRatioscrew = plastic_titanmod_kinkf0(instance)/(kB*Temperature) - - else ! if the structure is not hex or the slip family is basal - screwvelocity_prefactor=plastic_titanmod_v0s_PerSlipSys(j,instance) - bottomstress_screw=plastic_titanmod_tau0s_PerSlipSys(j,instance)+ & - plasticState(ph)%state(6*ns+nt+j, of) - StressRatio_screw_p = ((abs(tau_slip(j)))/( bottomstress_screw ))**plastic_titanmod_ps_PerSlipSys(j,instance) - - if((1.0_pReal-StressRatio_screw_p)>0.001_pReal) then - minusStressRatio_screw_p=1.0_pReal-StressRatio_screw_p - else - minusStressRatio_screw_p=0.001_pReal - endif - - StressRatio_screw_pminus1 = ((abs(tau_slip(j)))/( bottomstress_screw))** & - (plastic_titanmod_ps_PerSlipSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio for screw - BoltzmannRatioscrew = plastic_titanmod_f0_PerSlipSys(j,instance)/(kB*Temperature) - - endif - - !* Stress ratio for edge - bottomstress_edge=plastic_titanmod_tau0e_PerSlipSys(j,instance)+ & - plasticState(ph)%state(5*ns+nt+j, of) - StressRatio_edge_p = ((abs(tau_slip(j)))/ & - ( bottomstress_edge) & - )**plastic_titanmod_pe_PerSlipSys(j,instance) - - if((1.0_pReal-StressRatio_edge_p)>0.001_pReal) then - minusStressRatio_edge_p=1.0_pReal-StressRatio_edge_p - else - minusStressRatio_edge_p=0.001_pReal - endif - - StressRatio_edge_pminus1 = ((abs(tau_slip(j)))/( bottomstress_edge))** & - (plastic_titanmod_pe_PerSlipSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio for edge. For screws it is defined above - BoltzmannRatioedge = plastic_titanmod_f0_PerSlipSys(j,instance)/(kB*Temperature) - - screw_velocity(j) =screwvelocity_prefactor * & ! there is no v0 for screw now because it is included in the prefactor - exp(-BoltzmannRatioscrew*(minusStressRatio_screw_p)** & - plastic_titanmod_qs_PerSlipSys(j,instance)) - - edge_velocity(j) =plastic_titanmod_v0e_PerSlipSys(j,instance)*exp(-BoltzmannRatioedge* & - (minusStressRatio_edge_p)** & - plastic_titanmod_qe_PerSlipSys(j,instance)) - - !* Shear rates due to edge slip - gdot_slip_edge(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(j, of)* & - edge_velocity(j))* sign(1.0_pReal,tau_slip(j)) - !* Shear rates due to screw slip - gdot_slip_screw(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(plasticState(ph)%state(ns+j, of) * & - screw_velocity(j))* sign(1.0_pReal,tau_slip(j)) - !Total shear rate - - gdot_slip(j) = gdot_slip_edge(j) + gdot_slip_screw(j) - - plasticState(ph)%state( 7*ns+2*nt+j, of)= edge_velocity(j) - plasticState(ph)%state( 8*ns+2*nt+j, of)= screw_velocity(j) - plasticState(ph)%state( 9*ns+2*nt+j, of)= tau_slip(j) - plasticState(ph)%state(10*ns+2*nt+j, of)= gdot_slip_edge(j) - plasticState(ph)%state(11*ns+2*nt+j, of)= gdot_slip_screw(j) - plasticState(ph)%state(12*ns+2*nt+j, of)= StressRatio_edge_p - plasticState(ph)%state(13*ns+2*nt+j, of)= StressRatio_screw_p - - !* Derivatives of shear rates - dgdot_dtauslip(j) = plastic_titanmod_burgersPerSlipSys(j,instance)*(( & - ( & - ( & - ( & - (edge_velocity(j)*plasticState(ph)%state(j, of))) * & - BoltzmannRatioedge*& - plastic_titanmod_pe_PerSlipSys(j,instance)* & - plastic_titanmod_qe_PerSlipSys(j,instance) & - )/ & - bottomstress_edge & - )*& - StressRatio_edge_pminus1*(minusStressRatio_edge_p)** & - (plastic_titanmod_qe_PerSlipSys(j,instance)-1.0_pReal) & - ) + & - ( & - ( & - ( & - (plasticState(ph)%state(ns+j, of) * screw_velocity(j)) * & - BoltzmannRatioscrew* & - plastic_titanmod_ps_PerSlipSys(j,instance)* & - plastic_titanmod_qs_PerSlipSys(j,instance) & - )/ & - bottomstress_screw & - )*& - StressRatio_screw_pminus1*(minusStressRatio_screw_p)**(plastic_titanmod_qs_PerSlipSys(j,instance)-1.0_pReal) & - ) & - ) !* sign(1.0_pReal,tau_slip(j)) - - - -!************************************************* -!sumf=0.0_pReal - !* Plastic velocity gradient for dislocation glide - Lp = Lp + (1.0_pReal - sumf)*gdot_slip(j)*lattice_Sslip(1:3,1:3,1,index_myFamily+i,ph) - - !* Calculation of the tangent of Lp - 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(j)*& - lattice_Sslip(k,l,1,index_myFamily+i,ph)*& - lattice_Sslip(m,n,1,index_myFamily+i,ph) - enddo - enddo slipFamiliesLoop - -!* Mechanical twinning part - gdot_twin = 0.0_pReal - dgdot_dtautwin = 0.0_pReal - j = 0_pInt - twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Ntwin(f,instance) ! process each (active) slip system in family - j = j+1_pInt - - !* Calculation of Lp - !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) - -!************************************************************************************** - !* Stress ratios -! StressRatio_r = (plasticState(ph)%state6*ns+3*nt+j, of)/tau_twin(j))**plastic_titanmod_r(instance) - - !* Shear rates and their derivatives due to twin -! if ( tau_twin(j) > 0.0_pReal ) !then -! gdot_twin(j) = 0.0_pReal!& -! (plastic_titanmod_MaxTwinFraction(instance)-sumf)*lattice_shearTwin(index_myFamily+i,ph)*& -! plasticState(ph)%state(6*ns+4*nt+j, of)*plastic_titanmod_Ndot0PerTwinSys(f,instance)*exp(-StressRatio_r) -! dgdot_dtautwin(j) = ((gdot_twin(j)*plastic_titanmod_r(instance))/tau_twin(j))*StressRatio_r -! endif -!************************************************************************************** - - !* Stress ratio for edge - twinStressRatio_p = ((abs(tau_twin(j)))/ & - ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & - )**plastic_titanmod_twinp_PerTwinSys(j,instance) - - if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then - twinminusStressRatio_p=1.0_pReal-twinStressRatio_p - else - twinminusStressRatio_p=0.001_pReal - endif - - twinStressRatio_pminus1 = ((abs(tau_twin(j)))/ & - ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & - )**(plastic_titanmod_twinp_PerTwinSys(j,instance)-1.0_pReal) - - !* Boltzmann ratio - BoltzmannRatiotwin = plastic_titanmod_twinf0_PerTwinSys(j,instance)/(kB*Temperature) - - !* Initial twin shear rates - TwinDotGamma0 = & - plastic_titanmod_twingamma0_PerTwinSys(j,instance) - - !* Shear rates due to twin - gdot_twin(j) =sign(1.0_pReal,tau_twin(j))*plastic_titanmod_twingamma0_PerTwinSys(j,instance)* & - exp(-BoltzmannRatiotwin*(twinminusStressRatio_p)**plastic_titanmod_twinq_PerTwinSys(j,instance)) - - - !* Derivatives of shear rates in twin - dgdot_dtautwin(j) = ( & - ( & - ( & - (abs(gdot_twin(j))) * & - BoltzmannRatiotwin*& - plastic_titanmod_twinp_PerTwinSys(j,instance)* & - plastic_titanmod_twinq_PerTwinSys(j,instance) & - )/ & - plastic_titanmod_twintau0_PerTwinSys(j,instance) & - )*& - twinStressRatio_pminus1*(twinminusStressRatio_p)** & - (plastic_titanmod_twinq_PerTwinSys(j,instance)-1.0_pReal) & - ) !* sign(1.0_pReal,tau_slip(j)) - - !* Plastic velocity gradient for mechanical twinning -! Lp = Lp + sumf*gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) - Lp = Lp + gdot_twin(j)*lattice_Stwin(:,:,index_myFamily+i,ph) - - !* Calculation of the tangent of Lp - 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(j)*& - lattice_Stwin(k,l,index_myFamily+i,ph)*& - lattice_Stwin(m,n,index_myFamily+i,ph) - enddo - enddo twinFamiliesLoop - -dLp_dTstar99 = math_Plain3333to99(dLp_dTstar3333) -! tempState=state - - -end subroutine plastic_titanmod_LpAndItsTangent - - -!-------------------------------------------------------------------------------------------------- -!> @brief calculates the rate of change of microstructure -!-------------------------------------------------------------------------------------------------- -subroutine plastic_titanmod_dotState(Tstar_v,temperature,ipc,ip,el) - use lattice, only: & - lattice_Stwin_v, & - lattice_maxNslipFamily, & - lattice_maxNtwinFamily, & - lattice_NslipSystem, & - lattice_NtwinSystem - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - -implicit none - real(pReal), dimension(6), intent(in):: & - Tstar_v !< 2nd Piola Kirchhoff stress tensor in Mandel notation - real(pReal), intent(in) :: & - temperature !< temperature at integration point - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - - integer(pInt) :: & - index_myFamily, instance, & - ns,nt,& - f,i,j, & - ph, & - of - real(pReal) :: & - sumf,BoltzmannRatio, & - twinStressRatio_p,twinminusStressRatio_p - real(pReal), dimension(plastic_titanmod_totalNslip(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - DotRhoEdgeGeneration, & - DotRhoEdgeAnnihilation, & - DotRhoScrewGeneration, & - DotRhoScrewAnnihilation - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - gdot_twin, & - tau_twin, & - volumefraction_PerTwinSys - -!-------------------------------------------------------------------------------------------------- -! shortened notation - - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - - enddo - - sumf = sum(abs(volumefraction_PerTwinSys(1_pInt:nt))) ! safe for nt == 0 - - plasticState(ph)%dotState(:,of) = 0.0_pReal - j = 0_pInt - slipFamiliesLoop: do f = 1_pInt,lattice_maxNslipFamily - index_myFamily = sum(lattice_NslipSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Nslip(f,instance) ! process each (active) slip system in family - j = j+1_pInt - - DotRhoEdgeGeneration(j) = & ! multiplication of edge dislocations - plasticState(ph)%state(ns+j, of)*plasticState(ph)%state(8*ns+2*nt+j, of)/plasticState(ph)%state(4*ns+nt+j, of) - DotRhoScrewGeneration(j) = & ! multiplication of screw dislocations - plasticState(ph)%state(j, of)*plasticState(ph)%state(7*ns+2*nt+j, of)/plasticState(ph)%state(3*ns+nt+j, of) - DotRhoEdgeAnnihilation(j) = -((plasticState(ph)%state(j, of))**2)* & ! annihilation of edge dislocations - plastic_titanmod_capre_PerSlipSys(j,instance)*plasticState(ph)%state(7*ns+2*nt+j, of)*0.5_pReal - DotRhoScrewAnnihilation(j) = -((plasticState(ph)%state(ns+j, of))**2)* & ! annihilation of screw dislocations - plastic_titanmod_caprs_PerSlipSys(j,instance)*plasticState(ph)%state(8*ns+2*nt+j, of)*0.5_pReal - plasticState(ph)%dotState(j, of) = & ! edge dislocation density rate of change - DotRhoEdgeGeneration(j)+DotRhoEdgeAnnihilation(j) - - plasticState(ph)%dotState(ns+j, of) = & ! screw dislocation density rate of change - DotRhoScrewGeneration(j)+DotRhoScrewAnnihilation(j) - - plasticState(ph)%dotState(2*ns+j, of) = & ! sum of shear due to edge and screw - plasticState(ph)%state(10*ns+2*nt+j, of)+plasticState(ph)%state(11*ns+2*nt+j, of) - enddo - enddo slipFamiliesLoop - -!* Twin fraction evolution - j = 0_pInt - twinFamiliesLoop: do f = 1_pInt,lattice_maxNtwinFamily - index_myFamily = sum(lattice_NtwinSystem(1:f-1_pInt,ph)) ! at which index starts my family - do i = 1_pInt,plastic_titanmod_Ntwin(f,instance) ! process each (active) twin system in family - j = j+1_pInt - - !* Resolved shear stress on twin system - tau_twin(j) = dot_product(Tstar_v,lattice_Stwin_v(:,index_myFamily+i,ph)) - - !* Stress ratio for edge - twinStressRatio_p = ((abs(tau_twin(j)))/ & - ( plastic_titanmod_twintau0_PerTwinSys(j,instance)+plasticState(ph)%state(7*ns+nt+j, of)) & - )**(plastic_titanmod_twinp_PerTwinSys(j,instance)) - - - if((1.0_pReal-twinStressRatio_p)>0.001_pReal) then - twinminusStressRatio_p=1.0_pReal-twinStressRatio_p - else - twinminusStressRatio_p=0.001_pReal - endif - - BoltzmannRatio = plastic_titanmod_twinf0_PerTwinSys(j,instance)/(kB*Temperature) - - gdot_twin(j) =plastic_titanmod_twingamma0_PerTwinSys(j,instance)*exp(-BoltzmannRatio* & - (twinminusStressRatio_p)** & - plastic_titanmod_twinq_PerTwinSys(j,instance))*sign(1.0_pReal,tau_twin(j)) - - plasticState(ph)%dotState(3*ns+j, of)=gdot_twin(j) - - enddo - enddo twinFamiliesLoop - -end subroutine plastic_titanmod_dotState - -!-------------------------------------------------------------------------------------------------- -!> @brief return array of constitutive results -!-------------------------------------------------------------------------------------------------- -function plastic_titanmod_postResults(ipc,ip,el) - use material, only: & - material_phase, & - phase_plasticityInstance, & - plasticState, & - phaseAt, phasememberAt - - implicit none - integer(pInt), intent(in) :: & - ipc, & !< component-ID of integration point - ip, & !< integration point - el !< element - real(pReal), dimension(plastic_titanmod_sizePostResults(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - plastic_titanmod_postResults - - integer(pInt) :: & - instance, & - ns,nt,& - o,i,c, & - ph, & - of - real(pReal) :: sumf - - real(pReal), dimension(plastic_titanmod_totalNtwin(phase_plasticityInstance(material_phase(ipc,ip,el)))) :: & - volumefraction_PerTwinSys - -!-------------------------------------------------------------------------------------------------- -! shortened notation - of = phasememberAt(ipc,ip,el) - ph = phaseAt(ipc,ip,el) - instance = phase_plasticityInstance(ph) - ns = plastic_titanmod_totalNslip(instance) - nt = plastic_titanmod_totalNtwin(instance) - - do i=1_pInt,nt - volumefraction_PerTwinSys(i)=plasticState(ph)%state(3_pInt*ns+i, of)/ & - plastic_titanmod_twinshearconstant_PerTwinSys(i,instance) - enddo - - sumf = sum(abs(volumefraction_PerTwinSys(1:nt))) ! safe for nt == 0 - - -!-------------------------------------------------------------------------------------------------- -! required output - c = 0_pInt - plastic_titanmod_postResults = 0.0_pReal - - do o = 1_pInt,plastic_titanmod_Noutput(instance) - select case(plastic_titanmod_outputID(o,instance)) - case (rhoedge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(1_pInt:ns, of) - c = c + ns - case (rhoscrew_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(ns+1_pInt:2_pInt*ns, of) - c = c + ns - case (segment_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(3_pInt*ns+nt+1_pInt:4_pInt*ns+nt, of) - c = c + ns - case (segment_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(4_pInt*ns+nt+1_pInt:5_pInt*ns+nt, of) - c = c + ns - case (resistance_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(5_pInt*ns+nt+1_pInt:6_pInt*ns+nt, of) - c = c + ns - case (resistance_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(6_pInt*ns+nt+1_pInt:7_pInt*ns+nt, of) - c = c + ns - case (velocity_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(7*ns+2*nt+1:8*ns+2*nt, of) - c = c + ns - case (velocity_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = plasticState(ph)%state(8*ns+2*nt+1:9*ns+2*nt, of) - c = c + ns - case (tau_slip_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(9*ns+2*nt+1:10*ns+2*nt, of)) - c = c + ns - case (gdot_slip_edge_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) - c = c + ns - case (gdot_slip_screw_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) - c = c + ns - case (gdot_slip_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(10*ns+2*nt+1:11*ns+2*nt, of)) + & - abs(plasticState(ph)%state(11*ns+2*nt+1:12*ns+2*nt, of)) - c = c + ns - case (stressratio_edge_p_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(12*ns+2*nt+1:13*ns+2*nt, of)) - c = c + ns - case (stressratio_screw_p_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(13*ns+2*nt+1:14*ns+2*nt, of)) - c = c + ns - case (shear_system_ID) - plastic_titanmod_postResults(c+1_pInt:c+ns) = abs(plasticState(ph)%state(2*ns+1:3*ns, of)) - c = c + ns - case (shear_basal_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:2*ns+3, of))) - c = c + 1_pInt - case (shear_prism_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+4:2*ns+6, of))) - c = c + 1_pInt - case (shear_pyra_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+7:2*ns+12, of))) - c = c + 1_pInt - case (shear_pyrca_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+13:2*ns+24, of))) - c = c + 1_pInt - - case (rhoedge_basal_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(1:3, of)) - c = c + 1_pInt - case (rhoedge_prism_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(4:6, of)) - c = c + 1_pInt - case (rhoedge_pyra_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(7:12,of)) - c = c + 1_pInt - case (rhoedge_pyrca_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(13:24, of)) - c = c + 1_pInt - - case (rhoscrew_basal_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+1:ns+3, of)) - c = c + 1_pInt - case (rhoscrew_prism_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+4:ns+6, of)) - c = c + 1_pInt - case (rhoscrew_pyra_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+7:ns+12, of)) - c = c + 1_pInt - case (rhoscrew_pyrca_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(plasticState(ph)%state(ns+13:ns+24, of)) - c = c + 1_pInt - case (shear_total_ID) - plastic_titanmod_postResults(c+1_pInt:c+1_pInt) = sum(abs(plasticState(ph)%state(2*ns+1:3*ns, of))) - c = c + 1_pInt - case (twin_fraction_ID) - plastic_titanmod_postResults(c+1_pInt:c+nt) = abs(volumefraction_PerTwinSys(1:nt)) - c = c + nt - end select - enddo - -end function plastic_titanmod_postResults - -end module plastic_titanmod diff --git a/src/prec.f90 b/src/prec.f90 index 0e3b276db..912a02533 100644 --- a/src/prec.f90 +++ b/src/prec.f90 @@ -137,6 +137,7 @@ end subroutine prec_init !> @brief equality comparison for float with double precision ! replaces "==" but for certain (relative) tolerance. Counterpart to dNeq ! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! AlmostEqualRelative !-------------------------------------------------------------------------------------------------- logical elemental pure function dEq(a,b,tol) @@ -153,6 +154,7 @@ end function dEq !> @brief inequality comparison for float with double precision ! replaces "!=" but for certain (relative) tolerance. Counterpart to dEq ! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! AlmostEqualRelative NOT !-------------------------------------------------------------------------------------------------- logical elemental pure function dNeq(a,b,tol) @@ -167,33 +169,35 @@ end function dNeq !-------------------------------------------------------------------------------------------------- !> @brief equality to 0 comparison for float with double precision -! replaces "==0" but for certain (absolute) tolerance. Counterpart to dNeq0 -! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! replaces "==0" but everything not representable as a normal number is treated as 0. Counterpart to dNeq0 +! https://de.mathworks.com/help/matlab/ref/realmin.html +! https://docs.oracle.com/cd/E19957-01/806-3568/ncg_math.html !-------------------------------------------------------------------------------------------------- logical elemental pure function dEq0(a,tol) implicit none real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C + real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))*10.0_pReal) + dEq0 = merge(.True., .False.,abs(a) <= merge(tol,eps,present(tol))) end function dEq0 !-------------------------------------------------------------------------------------------------- !> @brief inequality to 0 comparison for float with double precision -! replaces "!=0" but for certain (absolute) tolerance. Counterpart to dEq0 -! https://randomascii.wordpress.com/2012/02/25/comparing-floating-point-numbers-2012-edition/ +! replaces "!=0" but everything not representable as a normal number is treated as 0. Counterpart to dEq0 +! https://de.mathworks.com/help/matlab/ref/realmin.html +! https://docs.oracle.com/cd/E19957-01/806-3568/ncg_math.html !-------------------------------------------------------------------------------------------------- logical elemental pure function dNeq0(a,tol) implicit none real(pReal), intent(in) :: a real(pReal), intent(in), optional :: tol - real(pReal), parameter :: eps = 2.220446049250313E-16 ! DBL_EPSILON in C + real(pReal), parameter :: eps = 2.2250738585072014E-308 ! smallest non-denormalized number - dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))*10.0_pReal) + dNeq0 = merge(.False., .True.,abs(a) <= merge(tol,eps,present(tol))) end function dNeq0 diff --git a/src/spectral_mech_Basic.f90 b/src/spectral_mech_Basic.f90 index cfb727129..55403ee7c 100644 --- a/src/spectral_mech_Basic.f90 +++ b/src/spectral_mech_Basic.f90 @@ -310,7 +310,6 @@ subroutine BasicPETSC_formResidual(in,x_scal,f_scal,dummy,ierr) debug_spectral, & debug_spectralRotation use spectral_utilities, only: & - wgt, & tensorField_real, & utilities_FFTtensorForward, & utilities_fourierGammaConvolution, & diff --git a/src/spectral_utilities.f90 b/src/spectral_utilities.f90 index 7417560a5..1efaf8879 100755 --- a/src/spectral_utilities.f90 +++ b/src/spectral_utilities.f90 @@ -971,6 +971,9 @@ subroutine utilities_constitutiveResponse(F_lastInc,F,timeinc, & real(pReal), dimension(3,3,3,3) :: max_dPdF, min_dPdF real(pReal) :: max_dPdF_norm, min_dPdF_norm, defgradDetMin, defgradDetMax, defgradDet + external :: & + MPI_Allreduce + write(6,'(/,a)') ' ... evaluating constitutive response ......................................' flush(6) age = .False.